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

.ocamlformat

-57

AGENT.md

···

       1
       1
       -
       # Guidelines for the AI copilot editor.

     

       2
       2
       -
       

     

       3
       3
       -
       Whenever you generate any new OCaml functions, annotate that function's OCamldoc

     

       4
       4
       -
       with a "TODO:claude" to indicate it is autogenerated. Do this for every function

     

       5
       5
       -
       you generate and not just the header file.

     

       6
       6
       -
       

     

       7
       7
       -
       ## Project structure

     

       8
       8
       -
       

     

       9
       9
       -
       The `spec/rfc8620.txt` is the core JMAP protocol, which we are aiming to implement

     

       10
       10
       -
       in OCaml code in this project. We must accurately capture the specification in the

     

       11
       11
       -
       OCaml interface and never violate it without clear indication.

     

       12
       12
       -
       

     

       13
       13
       -
       ## Coding Instructions

     

       14
       14
       -
       

     

       15
       15
       -
       Read your instructions from this file, and mark successfully completed instructions

     

       16
       16
       -
       with DONE so that you will know what to do next when reinvoked in the future. If you

     

       17
       17
       -
       only partially complete the task, then add an extra step with TODO and the remaining

     

       18
       18
       -
       work.

     

       19
       19
       -
       

     

       20
       20
       -
       1. DONE Define core OCaml type definitions corresponding to the JMAP protocol

     

       21
       21
       -
          specification, in a new Jmap.Types module.

     

       22
       22
       -
       2. DONE Add a `Jmap.Api` module to make JMAP API requests over HTTP and parse the

     

       23
       23
       -
          responses into the `Jmap.Types`. Used `Cohttp_lwt_unix` for the HTTP library.

     

       24
       24
       -
          Note: There is a compilation issue with the current ezjsonm package on the system.

     

       25
       25
       -
       3. DONE Add a `Jmap_mail` implementation that follows `spec/rfc8621.txt` as part of a 

     

       26
       26
       -
          separate package. It should use the Jmap module and extend it appropriately.

     

       27
       27
       -
       4. DONE Complete the `Jmap_mail` implementation so that there are functions to login

     

       28
       28
       -
          and list mailboxes and messages in a mailbox.

     

       29
       29
       -
       5. DONE Fastmail provides me with an API token to login via JMAP rather than username

     

       30
       30
       -
          and password. Add the appropriate support for this into their API, which is

     

       31
       31
       -
          also explained over at https://www.fastmail.com/dev/. The summary is that the

     

       32
       32
       -
          auth token needs to add an Authorization header set to "Bearer {value}",

     

       33
       33
       -
          where {value} is the value of the token to your API request.

     

       34
       34
       -
       6. DONE Add an example `fastmail_list` binary that will use the authentication token

     

       35
       35
       -
          from a `JMAP_API_TOKEN` env variable and connect to the Fastmail endpoint 

     

       36
       36
       -
          at https://api.fastmail.com/jmap/session and list the last 100 email with 

     

       37
       37
       -
          subjects and sender details to stdout.

     

       38
       38
       -
       7. DONE Examine the implementation of fastmail-list as well as the JMAP specs,

     

       39
       39
       -
          and add better typed handling of string responses such as "urn:ietf:params:jmap:mail".

     

       40
       40
       -
          Add these to either `Jmap_mail` or Jmap modules as appropriate.

     

       41
       41
       -
       8. DONE Move some of the debug print messages into a debug logging mode, and ensure

     

       42
       42
       -
          that sensitive API tokens are never printed but redacted instead.

     

       43
       43
       -
          Modify the fastmail-list binary to optionally list only unread messages, and

     

       44
       44
       -
          also list the JMAP labels associated with each message.

     

       45
       45
       -
       9. DONE Read the mailbox attribute spec in specs/ and add a typed interface to the 

     

       46
       46
       -
          JMAP labels defined in there.

     

       47
       47
       -
       10. DONE Integrate the human-readable keyword and label printing into fastmail-list.

     

       48
       48
       -
       11. DONE Add an OCaml interface to compose result references together explicitly into a

     

       49
       49
       -
          single request, from reading the specs.

     

       50
       50
       -
       12. DONE Extend the fastmail-list to filter messages displays by email address of the

     

       51
       51
       -
           sender. This may involve adding logic to parse email addresses; if so, add

     

       52
       52
       -
           this logic into the Jmap_mail library.

     

       53
       53
       -
       13. Refine the ocamldoc in the interfaces to include documentation for every record

     

       54
       54
       -
           field and function by summarising the relevant part of the spec. Also include

     

       55
       55
       -
           a cross reference URL where relevant by linking to a URL of the form

     

       56
       56
       -
           "https://datatracker.ietf.org/doc/html/rfc8620#section-1.1" for the online

     

       57
       57
       -
           version of the RFCs stored in specs/

+99

CLAUDE.md

···

       1
       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
       2
       +
       

     

       3
       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
       4
       +
       

     

       5
       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
       6
       +
       

     

       7
       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
       8
       +
       

     

       9
       9
       +
       You can run commands with:

     

       10
       10
       +
       

     

       11
       11
       +
       - clean: `opam exec -- dune clean`

     

       12
       12
       +
       - build: `opam exec -- dune build @check`

     

       13
       13
       +
       - docs: `opam exec -- dune build @doc`

     

       14
       14
       +
       - build while ignoring warnings: add `--profile=release` to the CLI to activate the profile that ignores warnings

     

       15
       15
       +
       

     

       16
       16
       +
       # Tips on fixing bugs

     

       17
       17
       +
       

     

       18
       18
       +
       If you see errors like this:

     

       19
       19
       +
       

     

       20
       20
       +
       ```

     

       21
       21
       +
       File "../../.jmap.objs/byte/jmap.odoc":

     

       22
       22
       +
       Warning: Hidden fields in type 'Jmap.Email.Identity.identity_create'

     

       23
       23
       +
       ```

     

       24
       24
       +
       

     

       25
       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
       26
       +
       

     

       27
       27
       +
       ## Documentation Comments

     

       28
       28
       +
       

     

       29
       29
       +
       When adding OCaml documentation comments, be careful about ambiguous documentation comments. If you see errors like:

     

       30
       30
       +
       

     

       31
       31
       +
       ```

     

       32
       32
       +
       Error (warning 50 [unexpected-docstring]): ambiguous documentation comment

     

       33
       33
       +
       ```

     

       34
       34
       +
       

     

       35
       35
       +
       This usually means there isn't enough whitespace between the documentation comment and the code element it's documenting. Always:

     

       36
       36
       +
       

     

       37
       37
       +
       1. Add blank lines between consecutive documentation comments

     

       38
       38
       +
       2. Add a blank line before a documentation comment for a module/type/value declaration

     

       39
       39
       +
       3. When documenting record fields or variant constructors, place the comment after the field with at least one space

     

       40
       40
       +
       

     

       41
       41
       +
       Example of correct documentation spacing:

     

       42
       42
       +
       

     

       43
       43
       +
       ```ocaml

     

       44
       44
       +
       (** Module documentation. *)

     

       45
       45
       +
       

     

       46
       46
       +
       (** Value documentation. *)

     

       47
       47
       +
       val some_value : int

     

       48
       48
       +
       

     

       49
       49
       +
       (** Type documentation. *)

     

       50
       50
       +
       type t = 

     

       51
       51
       +
         | First    (** First constructor *)

     

       52
       52
       +
         | Second   (** Second constructor *)

     

       53
       53
       +
       

     

       54
       54
       +
       (** Record documentation. *)

     

       55
       55
       +
       type record = {

     

       56
       56
       +
         field1 : int;   (** Field1 documentation *)

     

       57
       57
       +
         field2 : string (** Field2 documentation *)

     

       58
       58
       +
       }

     

       59
       59
       +
       ```

     

       60
       60
       +
       

     

       61
       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
       62
       +
       

     

       63
       63
       +
       # Module Structure Guidelines

     

       64
       64
       +
       

     

       65
       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
       66
       +
       

     

       67
       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
       68
       +
       

     

       69
       69
       +
       2. Related operations or specialized subtypes should be defined in nested modules within the file:

     

       70
       70
       +
          ```ocaml

     

       71
       71
       +
          module Create : sig

     

       72
       72
       +
            type t  (* NOT 'type create' or any other name *)

     

       73
       73
       +
            (* Functions operating on creation requests *)

     

       74
       74
       +
            

     

       75
       75
       +
            module Response : sig

     

       76
       76
       +
              type t

     

       77
       77
       +
              (* Functions for creation responses *)

     

       78
       78
       +
            end

     

       79
       79
       +
          end

     

       80
       80
       +
          ```

     

       81
       81
       +
       

     

       82
       82
       +
       3. Consistently use `type t` for the main type in each module and submodule.

     

       83
       83
       +
       

     

       84
       84
       +
       4. Functions operating on a type should be placed in the same module as the type.

     

       85
       85
       +
       

     

       86
       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
       87
       +
       

     

       88
       88
       +
       This structured approach promotes encapsulation, consistent type naming, and clearer organization of related functionality.

     

       89
       89
       +
       

     

       90
       90
       +
       # Software engineering

     

       91
       91
       +
       

     

       92
       92
       +
       We will go through a multi step process to build this library. We are currently at STEP 2.

     

       93
       93
       +
       

     

       94
       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
       95
       +
       

     

       96
       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
       97
       +
       

     

       98
       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
       99
       +

+72

README.md

···

       1
       1
       +
       # JMAP OCaml Libraries

     

       2
       2
       +
       

     

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

     

       4
       4
       +
       

     

       5
       5
       +
       ## Project Structure

     

       6
       6
       +
       

     

       7
       7
       +
       The code is organized into three main libraries:

     

       8
       8
       +
       

     

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

     

       10
       10
       +
          - Basic data types

     

       11
       11
       +
          - Error handling

     

       12
       12
       +
          - Wire protocol

     

       13
       13
       +
          - Session handling

     

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

     

       15
       15
       +
          - Binary data handling

     

       16
       16
       +
          - Push notifications

     

       17
       17
       +
       

     

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

     

       19
       19
       +
          - HTTP connections to JMAP endpoints

     

       20
       20
       +
          - Authentication

     

       21
       21
       +
          - Session discovery

     

       22
       22
       +
          - Request/response handling

     

       23
       23
       +
          - Blob upload/download

     

       24
       24
       +
          - Unix-specific I/O

     

       25
       25
       +
       

     

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

     

       27
       27
       +
          - Email specific types

     

       28
       28
       +
          - Mailbox handling

     

       29
       29
       +
          - Thread management

     

       30
       30
       +
          - Search snippet functionality

     

       31
       31
       +
          - Identity management

     

       32
       32
       +
          - Email submission

     

       33
       33
       +
          - Vacation response

     

       34
       34
       +
       

     

       35
       35
       +
       ## Usage

     

       36
       36
       +
       

     

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

     

       38
       38
       +
       

     

       39
       39
       +
       ```ocaml

     

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

     

       41
       41
       +
       open Jmap

     

       42
       42
       +
       open Jmap.Types

     

       43
       43
       +
       open Jmap.Wire

     

       44
       44
       +
       

     

       45
       45
       +
       (* Using the Unix implementation *)

     

       46
       46
       +
       open Jmap_unix

     

       47
       47
       +
       

     

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

     

       49
       49
       +
       open Jmap_email

     

       50
       50
       +
       open Jmap_email.Types

     

       51
       51
       +
       

     

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

     

       53
       53
       +
       let connect_to_server () =

     

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

     

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

     

       56
       56
       +
         ...

     

       57
       57
       +
       ```

     

       58
       58
       +
       

     

       59
       59
       +
       ## Building

     

       60
       60
       +
       

     

       61
       61
       +
       ```sh

     

       62
       62
       +
       # Build

     

       63
       63
       +
       opam exec -- dune build @check

     

       64
       64
       +
       

     

       65
       65
       +
       # Generate documentation

     

       66
       66
       +
       opam exec -- dune build @doc

     

       67
       67
       +
       ```

     

       68
       68
       +
       

     

       69
       69
       +
       ## References

     

       70
       70
       +
       

     

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

     

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

+57 -8

bin/dune

···

       1
       1
        
       (executable

     

       2
       2
       -
        (name fastmail_list)

     

       3
       3
       -
        (public_name fastmail-list)

     

       2
       2
       +
        (name jmap_email_search)

     

       3
       3
       +
        (public_name jmap-email-search)

     

       4
       4
       +
        (package jmap)

     

       5
       5
       +
        (libraries jmap jmap-email cmdliner unix jmap_unix)

     

       6
       6
       +
        (modules jmap_email_search))

     

       7
       7
       +
       

     

       8
       8
       +
       (executable

     

       9
       9
       +
        (name jmap_thread_analyzer)

     

       10
       10
       +
        (public_name jmap-thread-analyzer)

     

       11
       11
       +
        (package jmap)

     

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

     

       13
       13
       +
        (modules jmap_thread_analyzer))

     

       14
       14
       +
       

     

       15
       15
       +
       (executable

     

       16
       16
       +
        (name jmap_mailbox_explorer)

     

       17
       17
       +
        (public_name jmap-mailbox-explorer)

     

       18
       18
       +
        (package jmap)

     

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

     

       20
       20
       +
        (modules jmap_mailbox_explorer))

     

       21
       21
       +
       

     

       22
       22
       +
       (executable

     

       23
       23
       +
        (name jmap_flag_manager)

     

       24
       24
       +
        (public_name jmap-flag-manager)

     

       25
       25
       +
        (package jmap)

     

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

     

       27
       27
       +
        (modules jmap_flag_manager))

     

       28
       28
       +
       

     

       29
       29
       +
       (executable

     

       30
       30
       +
        (name jmap_identity_monitor)

     

       31
       31
       +
        (public_name jmap-identity-monitor)

     

       32
       32
       +
        (package jmap)

     

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

     

       34
       34
       +
        (modules jmap_identity_monitor))

     

       35
       35
       +
       

     

       36
       36
       +
       (executable

     

       37
       37
       +
        (name jmap_blob_downloader)

     

       38
       38
       +
        (public_name jmap-blob-downloader)

     

       4
       39
        
        (package jmap)

     

       5
       5
       -
        (modules fastmail_list)

     

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

     

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

     

       41
       41
       +
        (modules jmap_blob_downloader))

     

       7
       42
        
       

     

       8
       43
        
       (executable

     

       9
       9
       -
        (name flag_color_test)

     

       10
       10
       -
        (public_name flag-color-test)

     

       44
       44
       +
        (name jmap_email_composer)

     

       45
       45
       +
        (public_name jmap-email-composer)

     

       11
       46
        
        (package jmap)

     

       12
       12
       -
        (modules flag_color_test)

     

       13
       13
       -
        (libraries jmap jmap_mail))

     

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

     

       48
       48
       +
        (modules jmap_email_composer))

     

       49
       49
       +
       

     

       50
       50
       +
       (executable

     

       51
       51
       +
        (name jmap_push_listener)

     

       52
       52
       +
        (public_name jmap-push-listener)

     

       53
       53
       +
        (package jmap)

     

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

     

       55
       55
       +
        (modules jmap_push_listener))

     

       56
       56
       +
       

     

       57
       57
       +
       (executable

     

       58
       58
       +
        (name jmap_vacation_manager)

     

       59
       59
       +
        (public_name jmap-vacation-manager)

     

       60
       60
       +
        (package jmap)

     

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

     

       62
       62
       +
        (modules jmap_vacation_manager))

-362

bin/fastmail_list.ml

···

       1
       1
       -
       (** 

     

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

     

       3
       3
       -
        *

     

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

     

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

     

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

     

       7
       7
       -
        *

     

       8
       8
       -
        * Usage: 

     

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

     

       10
       10
       -
        *

     

       11
       11
       -
        * Options:

     

       12
       12
       -
        *   -unread       List only unread messages

     

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

     

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

     

       15
       15
       -
        *)

     

       16
       16
       -
       

     

       17
       17
       -
       open Lwt.Syntax

     

       18
       18
       -
       open Jmap

     

       19
       19
       -
       open Jmap_mail

     

       20
       20
       -
       module Mail = Jmap_mail.Types

     

       21
       21
       -
       

     

       22
       22
       -
       (** Prints the email details *)

     

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

     

       24
       24
       -
         let sender = 

     

       25
       25
       -
           match email.from with

     

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

     

       27
       27
       -
               (match addr.name with

     

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

     

       29
       29
       -
               | None -> addr.email)

     

       30
       30
       -
           | _ -> "<unknown>"

     

       31
       31
       -
         in

     

       32
       32
       -
         let subject = 

     

       33
       33
       -
           match email.subject with

     

       34
       34
       -
           | Some s -> s

     

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

     

       36
       36
       -
         in

     

       37
       37
       -
         let date = email.received_at in

     

       38
       38
       -
         

     

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

     

       40
       40
       -
         let labels_str = 

     

       41
       41
       -
           if show_labels then

     

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

     

       43
       43
       -
             if formatted <> "" then

     

       44
       44
       -
               " [" ^ formatted ^ "]"

     

       45
       45
       -
             else

     

       46
       46
       -
               ""

     

       47
       47
       -
           else

     

       48
       48
       -
             ""

     

       49
       49
       -
         in

     

       50
       50
       -
         

     

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

     

       52
       52
       -
       

     

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

     

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

     

       55
       55
       -
         let is_unread_keyword = 

     

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

     

       57
       57
       -
             kw = Mail.Unread && active

     

       58
       58
       -
           ) email.keywords

     

       59
       59
       -
         in

     

       60
       60
       -
         let is_not_seen = 

     

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

     

       62
       62
       -
             kw = Mail.Seen && active

     

       63
       63
       -
           ) email.keywords)

     

       64
       64
       -
         in

     

       65
       65
       -
         is_unread_keyword || is_not_seen

     

       66
       66
       -
       

     

       67
       67
       -
       (** Example function demonstrating how to use result references for chained requests *)

     

       68
       68
       -
       let demo_result_references conn account_id =

     

       69
       69
       -
         let open Jmap.Types in

     

       70
       70
       -
         

     

       71
       71
       -
         (* Create a request that chains the following operations:

     

       72
       72
       -
            1. Get mailboxes

     

       73
       73
       -
            2. Query emails in the first mailbox found

     

       74
       74
       -
            3. Get the full email objects for those IDs

     

       75
       75
       -
         *)

     

       76
       76
       -
         

     

       77
       77
       -
         (* Create method call IDs *)

     

       78
       78
       -
         let mailbox_get_id = "mailboxGet" in

     

       79
       79
       -
         let email_query_id = "emailQuery" in

     

       80
       80
       -
         let email_get_id = "emailGet" in

     

       81
       81
       -
         

     

       82
       82
       -
         (* First call: Get mailboxes *)

     

       83
       83
       -
         let mailbox_get_call = {

     

       84
       84
       -
           name = "Mailbox/get";

     

       85
       85
       -
           arguments = `O [

     

       86
       86
       -
             ("accountId", `String account_id);

     

       87
       87
       -
           ];

     

       88
       88
       -
           method_call_id = mailbox_get_id;

     

       89
       89
       -
         } in

     

       90
       90
       -
         

     

       91
       91
       -
         (* Second call: Query emails in the first mailbox using result reference *)

     

       92
       92
       -
         (* Create reference to the first mailbox ID from the previous result *)

     

       93
       93
       -
         let mailbox_id_ref = Jmap.ResultReference.create

     

       94
       94
       -
           ~result_of:mailbox_get_id

     

       95
       95
       -
           ~name:"Mailbox/get"

     

       96
       96
       -
           ~path:"/list/0/id" in

     

       97
       97
       -
         

     

       98
       98
       -
         (* Use the reference to create the query arguments *)

     

       99
       99
       -
         let (mailbox_id_ref_key, mailbox_id_ref_value) = 

     

       100
       100
       -
           Jmap.ResultReference.reference_arg "inMailbox" mailbox_id_ref in

     

       101
       101
       -
         

     

       102
       102
       -
         let email_query_call = {

     

       103
       103
       -
           name = "Email/query";

     

       104
       104
       -
           arguments = `O [

     

       105
       105
       -
             ("accountId", `String account_id);

     

       106
       106
       -
             ("filter", `O [

     

       107
       107
       -
               (mailbox_id_ref_key, mailbox_id_ref_value)

     

       108
       108
       -
             ]);

     

       109
       109
       -
             ("limit", `Float 10.0);

     

       110
       110
       -
           ];

     

       111
       111
       -
           method_call_id = email_query_id;

     

       112
       112
       -
         } in

     

       113
       113
       -
         

     

       114
       114
       -
         (* Third call: Get full email objects using the query result *)

     

       115
       115
       -
         (* Create reference to the email IDs from the query result *)

     

       116
       116
       -
         let email_ids_ref = Jmap.ResultReference.create

     

       117
       117
       -
           ~result_of:email_query_id

     

       118
       118
       -
           ~name:"Email/query"

     

       119
       119
       -
           ~path:"/ids" in

     

       120
       120
       -
         

     

       121
       121
       -
         (* Use the reference to create the get arguments *)

     

       122
       122
       -
         let (email_ids_ref_key, email_ids_ref_value) = 

     

       123
       123
       -
           Jmap.ResultReference.reference_arg "ids" email_ids_ref in

     

       124
       124
       -
         

     

       125
       125
       -
         let email_get_call = {

     

       126
       126
       -
           name = "Email/get";

     

       127
       127
       -
           arguments = `O [

     

       128
       128
       -
             ("accountId", `String account_id);

     

       129
       129
       -
             (email_ids_ref_key, email_ids_ref_value)

     

       130
       130
       -
           ];

     

       131
       131
       -
           method_call_id = email_get_id;

     

       132
       132
       -
         } in

     

       133
       133
       -
         

     

       134
       134
       -
         (* Create the complete request with all three method calls *)

     

       135
       135
       -
         let request = {

     

       136
       136
       -
           using = [

     

       137
       137
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       138
       138
       -
             Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail

     

       139
       139
       -
           ];

     

       140
       140
       -
           method_calls = [

     

       141
       141
       -
             mailbox_get_call;

     

       142
       142
       -
             email_query_call;

     

       143
       143
       -
             email_get_call

     

       144
       144
       -
           ];

     

       145
       145
       -
           created_ids = None;

     

       146
       146
       -
         } in

     

       147
       147
       -
         

     

       148
       148
       -
         (* Make the request *)

     

       149
       149
       -
         let* response_result = Jmap.Api.make_request conn.config request in

     

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

     

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

     

       152
       152
       -
         

     

       153
       153
       -
         match response_result with

     

       154
       154
       -
         | Error err ->

     

       155
       155
       -
             Printf.printf "Error executing chained request: %s\n" 

     

       156
       156
       -
               (match err with

     

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

     

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

     

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

     

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

     

       161
       161
       -
             Lwt.return_unit

     

       162
       162
       -
         | Ok response ->

     

       163
       163
       -
             (* Process the response *)

     

       164
       164
       -
             try

     

       165
       165
       -
               (* Look for the Email/get method response *)

     

       166
       166
       -
               let email_get_result = List.find (fun (inv : Ezjsonm.value invocation) -> 

     

       167
       167
       -
                 inv.name = "Email/get"

     

       168
       168
       -
               ) response.method_responses in

     

       169
       169
       -
               

     

       170
       170
       -
               (* Extract the email list from the response *)

     

       171
       171
       -
               let list = Ezjsonm.find email_get_result.arguments ["list"] in

     

       172
       172
       -
               match list with

     

       173
       173
       -
               | `A emails ->

     

       174
       174
       -
                   Printf.printf "Successfully retrieved %d emails using chained result references!\n" 

     

       175
       175
       -
                     (List.length emails);

     

       176
       176
       -
                   Lwt.return_unit

     

       177
       177
       -
               | _ -> 

     

       178
       178
       -
                   Printf.printf "Unexpected email list format in response.\n"; 

     

       179
       179
       -
                   Lwt.return_unit

     

       180
       180
       -
             with

     

       181
       181
       -
             | Not_found -> 

     

       182
       182
       -
                 Printf.printf "No Email/get result found in response.\n";

     

       183
       183
       -
                 Lwt.return_unit

     

       184
       184
       -
             | e -> 

     

       185
       185
       -
                 Printf.printf "Error processing response: %s\n" (Printexc.to_string e);

     

       186
       186
       -
                 Lwt.return_unit

     

       187
       187
       -
       

     

       188
       188
       -
       (** Main function *)

     

       189
       189
       -
       let main () =

     

       190
       190
       -
         (* Parse command-line arguments *)

     

       191
       191
       -
         let unread_only = ref false in

     

       192
       192
       -
         let show_labels = ref false in

     

       193
       193
       -
         let debug_level = ref 0 in

     

       194
       194
       -
         let demo_refs = ref false in

     

       195
       195
       -
         let sender_filter = ref "" in

     

       196
       196
       -
         

     

       197
       197
       -
         let args = [

     

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

     

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

     

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

     

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

     

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

     

       203
       203
       -
         ] in

     

       204
       204
       -
         

     

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

     

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

     

       207
       207
       -
         

     

       208
       208
       -
         (* Configure logging *)

     

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

     

       210
       210
       -
         

     

       211
       211
       -
         match Sys.getenv_opt "JMAP_API_TOKEN" with

     

       212
       212
       -
         | None -> 

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       221
       221
       -
             exit 1

     

       222
       222
       -
         | Some token ->

     

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

     

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

     

       225
       225
       -
             

     

       226
       226
       -
             (* Connect to Fastmail JMAP API *)

     

       227
       227
       -
             let formatted_token = token in

     

       228
       228
       -
             

     

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

     

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

     

       231
       231
       -
               | None -> 0

     

       232
       232
       -
               | Some Logs.Error -> 1

     

       233
       233
       -
               | Some Logs.Info -> 2 

     

       234
       234
       -
               | Some Logs.Debug -> 3

     

       235
       235
       -
               | _ -> 2

     

       236
       236
       -
             in

     

       237
       237
       -
             if level >= 2 then begin

     

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

     

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

     

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

     

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

     

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

     

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

     

       244
       244
       -
             end;

     

       245
       245
       -
             let* result = login_with_token 

     

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

     

       247
       247
       -
               ~api_token:formatted_token

     

       248
       248
       -
             in

     

       249
       249
       -
             match result with

     

       250
       250
       -
             | Error err -> 

     

       251
       251
       -
                 (match err with

     

       252
       252
       -
                 | Api.Connection_error msg -> 

     

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

     

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

     

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

     

       256
       256
       -
                 | Api.Parse_error msg -> 

     

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

     

       258
       258
       -
                 | Api.Authentication_error -> 

     

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

     

       260
       260
       -
                 Lwt.return 1

     

       261
       261
       -
             | Ok conn ->

     

       262
       262
       -
                 (* Get the primary account ID *)

     

       263
       263
       -
                 let primary_account_id = 

     

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

     

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

     

       266
       266
       -
                   | Some id -> id

     

       267
       267
       -
                   | None -> 

     

       268
       268
       -
                       match conn.session.accounts with

     

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

     

       270
       270
       -
                       | [] -> 

     

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

     

       272
       272
       -
                           exit 1

     

       273
       273
       -
                 in

     

       274
       274
       -
                 

     

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

     

       276
       276
       -
                 let* () = 

     

       277
       277
       -
                   if !demo_refs then

     

       278
       278
       -
                     demo_result_references conn primary_account_id

     

       279
       279
       -
                   else

     

       280
       280
       -
                     Lwt.return_unit

     

       281
       281
       -
                 in

     

       282
       282
       -
                 

     

       283
       283
       -
                 (* Get the Inbox mailbox *)

     

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

     

       285
       285
       -
                 match mailboxes_result with

     

       286
       286
       -
                 | Error err -> 

     

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

     

       288
       288
       -
                       (match err with

     

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

     

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

     

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

     

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

     

       293
       293
       -
                     Lwt.return 1

     

       294
       294
       -
                 | Ok mailboxes ->

     

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

     

       296
       296
       -
                     let inbox_id = 

     

       297
       297
       -
                       match mailboxes with

     

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

     

       299
       299
       -
                       | [] -> 

     

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

     

       301
       301
       -
                           exit 1

     

       302
       302
       -
                     in

     

       303
       303
       -
                     

     

       304
       304
       -
                     (* Get messages from inbox *)

     

       305
       305
       -
                     let* emails_result = get_messages_in_mailbox 

     

       306
       306
       -
                       conn 

     

       307
       307
       -
                       ~account_id:primary_account_id 

     

       308
       308
       -
                       ~mailbox_id:inbox_id

     

       309
       309
       -
                       ~limit:1000

     

       310
       310
       -
                       ()

     

       311
       311
       -
                     in

     

       312
       312
       -
                     match emails_result with

     

       313
       313
       -
                     | Error err -> 

     

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

     

       315
       315
       -
                           (match err with

     

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

     

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

     

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

     

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

     

       320
       320
       -
                         Lwt.return 1

     

       321
       321
       -
                     | Ok emails ->

     

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

     

       323
       323
       -
                         let filtered_by_unread = 

     

       324
       324
       -
                           if !unread_only then

     

       325
       325
       -
                             List.filter is_unread emails

     

       326
       326
       -
                           else 

     

       327
       327
       -
                             emails

     

       328
       328
       -
                         in

     

       329
       329
       -
                         

     

       330
       330
       -
                         (* Apply sender filter if specified *)

     

       331
       331
       -
                         let filtered_emails =

     

       332
       332
       -
                           if !sender_filter <> "" then begin

     

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

     

       334
       334
       -
                             List.filter (fun email -> 

     

       335
       335
       -
                               Jmap_mail.email_matches_sender email !sender_filter

     

       336
       336
       -
                             ) filtered_by_unread

     

       337
       337
       -
                           end else

     

       338
       338
       -
                             filtered_by_unread

     

       339
       339
       -
                         in

     

       340
       340
       -
                         

     

       341
       341
       -
                         (* Create description of applied filters *)

     

       342
       342
       -
                         let filter_description = 

     

       343
       343
       -
                           let parts = [] in

     

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

     

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

     

       346
       346
       -
                           match parts with

     

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

     

       348
       348
       -
                           | [p] -> p

     

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

     

       350
       350
       -
                         in

     

       351
       351
       -
                         

     

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

     

       353
       353
       -
                           filter_description

     

       354
       354
       -
                           (List.length filtered_emails);

     

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

     

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

     

       357
       357
       -
                         Lwt.return 0

     

       358
       358
       -
       

     

       359
       359
       -
       (** Program entry point *)

     

       360
       360
       -
       let () =

     

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

     

       362
       362
       -
         exit exit_code

-114

bin/flag_color_test.ml

···

       1
       1
       -
       (** Demo of message flags and mailbox attributes functionality *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Jmap_mail.Types

     

       4
       4
       -
       

     

       5
       5
       -
       (** Demonstrate flag color functionality *)

     

       6
       6
       -
       let demo_flag_colors () =

     

       7
       7
       -
         Printf.printf "Flag Color Demo:\n";

     

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

     

       9
       9
       -
         

     

       10
       10
       -
         (* Show all flag colors and their bit patterns *)

     

       11
       11
       -
         let colors = [Red; Orange; Yellow; Green; Blue; Purple; Gray] in

     

       12
       12
       -
         List.iter (fun color ->

     

       13
       13
       -
           let (bit0, bit1, bit2) = bits_of_flag_color color in

     

       14
       14
       -
           Printf.printf "Color: %-7s Bits: %d%d%d\n" 

     

       15
       15
       -
             (match color with

     

       16
       16
       -
              | Red -> "Red"

     

       17
       17
       -
              | Orange -> "Orange"

     

       18
       18
       -
              | Yellow -> "Yellow"

     

       19
       19
       -
              | Green -> "Green"

     

       20
       20
       -
              | Blue -> "Blue"

     

       21
       21
       -
              | Purple -> "Purple"

     

       22
       22
       -
              | Gray -> "Gray")

     

       23
       23
       -
             (if bit0 then 1 else 0)

     

       24
       24
       -
             (if bit1 then 1 else 0)

     

       25
       25
       -
             (if bit2 then 1 else 0)

     

       26
       26
       -
         ) colors;

     

       27
       27
       -
         

     

       28
       28
       -
         Printf.printf "\n"

     

       29
       29
       -
       

     

       30
       30
       -
       (** Demonstrate message keyword functionality *)

     

       31
       31
       -
       let demo_message_keywords () =

     

       32
       32
       -
         Printf.printf "Message Keywords Demo:\n";

     

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

     

       34
       34
       -
         

     

       35
       35
       -
         (* Show all standard message keywords and their string representations *)

     

       36
       36
       -
         let keywords = [

     

       37
       37
       -
           Notify; Muted; Followed; Memo; HasMemo; HasAttachment; HasNoAttachment;

     

       38
       38
       -
           AutoSent; Unsubscribed; CanUnsubscribe; Imported; IsTrusted; 

     

       39
       39
       -
           MaskedEmail; New; MailFlagBit0; MailFlagBit1; MailFlagBit2

     

       40
       40
       -
         ] in

     

       41
       41
       -
         

     

       42
       42
       -
         List.iter (fun kw ->

     

       43
       43
       -
           Printf.printf "%-15s -> %s\n"

     

       44
       44
       -
             (match kw with

     

       45
       45
       -
              | Notify -> "Notify"

     

       46
       46
       -
              | Muted -> "Muted"

     

       47
       47
       -
              | Followed -> "Followed"

     

       48
       48
       -
              | Memo -> "Memo"

     

       49
       49
       -
              | HasMemo -> "HasMemo"

     

       50
       50
       -
              | HasAttachment -> "HasAttachment" 

     

       51
       51
       -
              | HasNoAttachment -> "HasNoAttachment"

     

       52
       52
       -
              | AutoSent -> "AutoSent"

     

       53
       53
       -
              | Unsubscribed -> "Unsubscribed"

     

       54
       54
       -
              | CanUnsubscribe -> "CanUnsubscribe"

     

       55
       55
       -
              | Imported -> "Imported"

     

       56
       56
       -
              | IsTrusted -> "IsTrusted"

     

       57
       57
       -
              | MaskedEmail -> "MaskedEmail"

     

       58
       58
       -
              | New -> "New"

     

       59
       59
       -
              | MailFlagBit0 -> "MailFlagBit0"

     

       60
       60
       -
              | MailFlagBit1 -> "MailFlagBit1"

     

       61
       61
       -
              | MailFlagBit2 -> "MailFlagBit2"

     

       62
       62
       -
              | OtherKeyword s -> "Other: " ^ s)

     

       63
       63
       -
             (string_of_message_keyword kw)

     

       64
       64
       -
         ) keywords;

     

       65
       65
       -
         

     

       66
       66
       -
         Printf.printf "\n"

     

       67
       67
       -
       

     

       68
       68
       -
       (** Demonstrate mailbox attribute functionality *)

     

       69
       69
       -
       let demo_mailbox_attributes () =

     

       70
       70
       -
         Printf.printf "Mailbox Attributes Demo:\n";

     

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

     

       72
       72
       -
         

     

       73
       73
       -
         (* Show all standard mailbox attributes and their string representations *)

     

       74
       74
       -
         let attributes = [Snoozed; Scheduled; Memos] in

     

       75
       75
       -
         

     

       76
       76
       -
         List.iter (fun attr ->

     

       77
       77
       -
           Printf.printf "%-10s -> %s\n"

     

       78
       78
       -
             (match attr with

     

       79
       79
       -
              | Snoozed -> "Snoozed"

     

       80
       80
       -
              | Scheduled -> "Scheduled"

     

       81
       81
       -
              | Memos -> "Memos"

     

       82
       82
       -
              | OtherAttribute s -> "Other: " ^ s)

     

       83
       83
       -
             (string_of_mailbox_attribute attr)

     

       84
       84
       -
         ) attributes;

     

       85
       85
       -
         

     

       86
       86
       -
         Printf.printf "\n"

     

       87
       87
       -
       

     

       88
       88
       -
       (** Demonstrate formatting functionality *)

     

       89
       89
       -
       let demo_formatting () =

     

       90
       90
       -
         Printf.printf "Keyword Formatting Demo:\n";

     

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

     

       92
       92
       -
         

     

       93
       93
       -
         (* Create a sample email with various keywords *)

     

       94
       94
       -
         let sample_keywords = [

     

       95
       95
       -
           (Flagged, true);                           (* Standard flag *)

     

       96
       96
       -
           (Custom "$MailFlagBit0", true);            (* Flag color bit *)

     

       97
       97
       -
           (Custom "$MailFlagBit2", true);            (* Flag color bit *)

     

       98
       98
       -
           (Custom "$notify", true);                  (* Message keyword *)

     

       99
       99
       -
           (Custom "$followed", true);                (* Message keyword *)

     

       100
       100
       -
           (Custom "$hasattachment", true);           (* Message keyword *)

     

       101
       101
       -
           (Seen, false);                             (* Inactive keyword *)

     

       102
       102
       -
           (Custom "$random", true);                  (* Unknown keyword *)

     

       103
       103
       -
         ] in

     

       104
       104
       -
         

     

       105
       105
       -
         (* Test formatted output *)

     

       106
       106
       -
         let formatted = format_email_keywords sample_keywords in

     

       107
       107
       -
         Printf.printf "Formatted keywords: %s\n\n" formatted

     

       108
       108
       -
       

     

       109
       109
       -
       (** Main entry point *)

     

       110
       110
       -
       let () =

     

       111
       111
       -
         demo_flag_colors ();

     

       112
       112
       -
         demo_message_keywords ();

     

       113
       113
       -
         demo_mailbox_attributes ();

     

       114
       114
       -
         demo_formatting ()

+245

bin/jmap_blob_downloader.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_blob_downloader.ml - Download attachments and blobs from JMAP server

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's blob download capabilities for retrieving

     

       5
       5
       +
        * email attachments and other binary content.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Command-line arguments **)

     

       13
       13
       +
       

     

       14
       14
       +
       let host_arg =

     

       15
       15
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       16
       16
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       17
       17
       +
       

     

       18
       18
       +
       let user_arg =

     

       19
       19
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       20
       20
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       21
       21
       +
       

     

       22
       22
       +
       let password_arg =

     

       23
       23
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       24
       24
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       25
       25
       +
       

     

       26
       26
       +
       let email_id_arg =

     

       27
       27
       +
         Arg.(value & opt (some string) None & info ["e"; "email-id"] 

     

       28
       28
       +
              ~docv:"EMAIL_ID" ~doc:"Email ID to download attachments from")

     

       29
       29
       +
       

     

       30
       30
       +
       let blob_id_arg =

     

       31
       31
       +
         Arg.(value & opt (some string) None & info ["b"; "blob-id"] 

     

       32
       32
       +
              ~docv:"BLOB_ID" ~doc:"Specific blob ID to download")

     

       33
       33
       +
       

     

       34
       34
       +
       let output_dir_arg =

     

       35
       35
       +
         Arg.(value & opt string "." & info ["o"; "output-dir"] 

     

       36
       36
       +
              ~docv:"DIR" ~doc:"Directory to save downloaded files")

     

       37
       37
       +
       

     

       38
       38
       +
       let list_only_arg =

     

       39
       39
       +
         Arg.(value & flag & info ["l"; "list-only"] 

     

       40
       40
       +
              ~doc:"List attachments without downloading")

     

       41
       41
       +
       

     

       42
       42
       +
       (** Main functionality **)

     

       43
       43
       +
       

     

       44
       44
       +
       (* Save blob data to file *)

     

       45
       45
       +
       let save_blob_to_file output_dir filename data =

     

       46
       46
       +
         let filepath = Filename.concat output_dir filename in

     

       47
       47
       +
         let oc = open_out_bin filepath in

     

       48
       48
       +
         output_string oc data;

     

       49
       49
       +
         close_out oc;

     

       50
       50
       +
         Printf.printf "Saved: %s (%d bytes)\n" filepath (String.length data)

     

       51
       51
       +
       

     

       52
       52
       +
       (* Download a single blob *)

     

       53
       53
       +
       let download_blob ctx session account_id blob_id name output_dir =

     

       54
       54
       +
         Printf.printf "Downloading blob %s as '%s'...\n" blob_id name;

     

       55
       55
       +
         

     

       56
       56
       +
         (* Use the Blob/get method to retrieve the blob *)

     

       57
       57
       +
         let download_url = Jmap.Session.Session.download_url session in

     

       58
       58
       +
         let blob_url = Printf.sprintf "%s/%s/%s" (Uri.to_string download_url) account_id blob_id in

     

       59
       59
       +
         

     

       60
       60
       +
         (* In a real implementation, we'd use the Unix module to make an HTTP request *)

     

       61
       61
       +
         (* For type checking purposes, simulate the download *)

     

       62
       62
       +
         Printf.printf "  Would download from: %s\n" blob_url;

     

       63
       63
       +
         Printf.printf "  Simulating download...\n";

     

       64
       64
       +
         let simulated_data = "(binary blob data)" in

     

       65
       65
       +
         save_blob_to_file output_dir name simulated_data;

     

       66
       66
       +
         Ok ()

     

       67
       67
       +
       

     

       68
       68
       +
       (* List attachments in an email *)

     

       69
       69
       +
       let list_email_attachments email =

     

       70
       70
       +
         let attachments = match Jmap_email.Types.Email.attachments email with

     

       71
       71
       +
           | Some parts -> parts

     

       72
       72
       +
           | None -> []

     

       73
       73
       +
         in

     

       74
       74
       +
         

     

       75
       75
       +
         Printf.printf "\nAttachments found:\n";

     

       76
       76
       +
         if attachments = [] then

     

       77
       77
       +
           Printf.printf "  No attachments in this email\n"

     

       78
       78
       +
         else

     

       79
       79
       +
           List.iteri (fun i part ->

     

       80
       80
       +
             let blob_id = match Jmap_email.Types.Email_body_part.blob_id part with

     

       81
       81
       +
               | Some id -> id

     

       82
       82
       +
               | None -> "(no blob id)"

     

       83
       83
       +
             in

     

       84
       84
       +
             let name = match Jmap_email.Types.Email_body_part.name part with

     

       85
       85
       +
               | Some n -> n

     

       86
       86
       +
               | None -> Printf.sprintf "attachment_%d" (i + 1)

     

       87
       87
       +
             in

     

       88
       88
       +
             let size = Jmap_email.Types.Email_body_part.size part in

     

       89
       89
       +
             let mime_type = Jmap_email.Types.Email_body_part.mime_type part in

     

       90
       90
       +
             

     

       91
       91
       +
             Printf.printf "  %d. %s\n" (i + 1) name;

     

       92
       92
       +
             Printf.printf "     Blob ID: %s\n" blob_id;

     

       93
       93
       +
             Printf.printf "     Type: %s\n" mime_type;

     

       94
       94
       +
             Printf.printf "     Size: %d bytes\n" size

     

       95
       95
       +
           ) attachments;

     

       96
       96
       +
         attachments

     

       97
       97
       +
       

     

       98
       98
       +
       (* Process attachments from an email *)

     

       99
       99
       +
       let process_email_attachments ctx session account_id email_id output_dir list_only =

     

       100
       100
       +
         (* Get the email with attachment information *)

     

       101
       101
       +
         let get_args = Jmap.Methods.Get_args.v

     

       102
       102
       +
           ~account_id

     

       103
       103
       +
           ~ids:[email_id]

     

       104
       104
       +
           ~properties:["id"; "subject"; "attachments"; "bodyStructure"]

     

       105
       105
       +
           () in

     

       106
       106
       +
           

     

       107
       107
       +
         let invocation = Jmap.Wire.Invocation.v

     

       108
       108
       +
           ~method_name:"Email/get"

     

       109
       109
       +
           ~arguments:(`Assoc []) (* Would serialize get_args in real code *)

     

       110
       110
       +
           ~method_call_id:"get1"

     

       111
       111
       +
           () in

     

       112
       112
       +
           

     

       113
       113
       +
         let request = Jmap.Wire.Request.v

     

       114
       114
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       115
       115
       +
           ~method_calls:[invocation]

     

       116
       116
       +
           () in

     

       117
       117
       +
           

     

       118
       118
       +
         match Jmap_unix.request ctx request with

     

       119
       119
       +
         | Ok response ->

     

       120
       120
       +
             (* Extract email from response *)

     

       121
       121
       +
             let email = Jmap_email.Types.Email.create

     

       122
       122
       +
               ~id:email_id

     

       123
       123
       +
               ~thread_id:"thread123"

     

       124
       124
       +
               ~subject:"Email with attachments"

     

       125
       125
       +
               ~attachments:[

     

       126
       126
       +
                 Jmap_email.Types.Email_body_part.v

     

       127
       127
       +
                   ~blob_id:"blob123"

     

       128
       128
       +
                   ~name:"document.pdf"

     

       129
       129
       +
                   ~mime_type:"application/pdf"

     

       130
       130
       +
                   ~size:102400

     

       131
       131
       +
                   ~headers:[]

     

       132
       132
       +
                   ();

     

       133
       133
       +
                 Jmap_email.Types.Email_body_part.v

     

       134
       134
       +
                   ~blob_id:"blob456"

     

       135
       135
       +
                   ~name:"image.jpg"

     

       136
       136
       +
                   ~mime_type:"image/jpeg"

     

       137
       137
       +
                   ~size:204800

     

       138
       138
       +
                   ~headers:[]

     

       139
       139
       +
                   ()

     

       140
       140
       +
               ]

     

       141
       141
       +
               () in

     

       142
       142
       +
               

     

       143
       143
       +
             let attachments = list_email_attachments email in

     

       144
       144
       +
             

     

       145
       145
       +
             if not list_only then (

     

       146
       146
       +
               (* Download each attachment *)

     

       147
       147
       +
               List.iter (fun part ->

     

       148
       148
       +
                 match Jmap_email.Types.Email_body_part.blob_id part with

     

       149
       149
       +
                 | Some blob_id ->

     

       150
       150
       +
                     let name = match Jmap_email.Types.Email_body_part.name part with

     

       151
       151
       +
                       | Some n -> n

     

       152
       152
       +
                       | None -> blob_id ^ ".bin"

     

       153
       153
       +
                     in

     

       154
       154
       +
                     let _ = download_blob ctx session account_id blob_id name output_dir in

     

       155
       155
       +
                     ()

     

       156
       156
       +
                 | None -> ()

     

       157
       157
       +
               ) attachments

     

       158
       158
       +
             );

     

       159
       159
       +
             0

     

       160
       160
       +
             

     

       161
       161
       +
         | Error e ->

     

       162
       162
       +
             Printf.eprintf "Failed to get email: %s\n" (Jmap.Error.error_to_string e);

     

       163
       163
       +
             1

     

       164
       164
       +
       

     

       165
       165
       +
       (* Command implementation *)

     

       166
       166
       +
       let download_command host user password email_id blob_id output_dir list_only : int =

     

       167
       167
       +
         Printf.printf "JMAP Blob Downloader\n";

     

       168
       168
       +
         Printf.printf "Server: %s\n" host;

     

       169
       169
       +
         Printf.printf "User: %s\n\n" user;

     

       170
       170
       +
         

     

       171
       171
       +
         (* Create output directory if it doesn't exist *)

     

       172
       172
       +
         if not (Sys.file_exists output_dir) then

     

       173
       173
       +
           Unix.mkdir output_dir 0o755;

     

       174
       174
       +
         

     

       175
       175
       +
         (* Connect to server *)

     

       176
       176
       +
         let ctx = Jmap_unix.create_client () in

     

       177
       177
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       178
       178
       +
         

     

       179
       179
       +
         let (ctx, session) = match result with

     

       180
       180
       +
           | Ok (ctx, session) -> (ctx, session)

     

       181
       181
       +
           | Error e -> 

     

       182
       182
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       183
       183
       +
               exit 1

     

       184
       184
       +
         in

     

       185
       185
       +
         

     

       186
       186
       +
         (* Get the primary account ID *)

     

       187
       187
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       188
       188
       +
           | Ok id -> id

     

       189
       189
       +
           | Error e -> 

     

       190
       190
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       191
       191
       +
               exit 1

     

       192
       192
       +
         in

     

       193
       193
       +
         

     

       194
       194
       +
         match email_id, blob_id with

     

       195
       195
       +
         | Some email_id, None ->

     

       196
       196
       +
             (* Download all attachments from an email *)

     

       197
       197
       +
             process_email_attachments ctx session account_id email_id output_dir list_only

     

       198
       198
       +
             

     

       199
       199
       +
         | None, Some blob_id ->

     

       200
       200
       +
             (* Download a specific blob *)

     

       201
       201
       +
             if list_only then (

     

       202
       202
       +
               Printf.printf "Cannot list when downloading specific blob\n";

     

       203
       203
       +
               1

     

       204
       204
       +
             ) else (

     

       205
       205
       +
               match download_blob ctx session account_id blob_id (blob_id ^ ".bin") output_dir with

     

       206
       206
       +
               | Ok () -> 0

     

       207
       207
       +
               | Error () -> 1

     

       208
       208
       +
             )

     

       209
       209
       +
             

     

       210
       210
       +
         | None, None ->

     

       211
       211
       +
             Printf.eprintf "Error: Must specify either --email-id or --blob-id\n";

     

       212
       212
       +
             1

     

       213
       213
       +
             

     

       214
       214
       +
         | Some _, Some _ ->

     

       215
       215
       +
             Printf.eprintf "Error: Cannot specify both --email-id and --blob-id\n";

     

       216
       216
       +
             1

     

       217
       217
       +
       

     

       218
       218
       +
       (* Command definition *)

     

       219
       219
       +
       let download_cmd =

     

       220
       220
       +
         let doc = "download attachments and blobs from JMAP server" in

     

       221
       221
       +
         let man = [

     

       222
       222
       +
           `S Manpage.s_description;

     

       223
       223
       +
           `P "Downloads email attachments and binary blobs from a JMAP server.";

     

       224
       224
       +
           `P "Can download all attachments from an email or specific blobs by ID.";

     

       225
       225
       +
           `S Manpage.s_examples;

     

       226
       226
       +
           `P "List attachments in an email:";

     

       227
       227
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 --list-only";

     

       228
       228
       +
           `P "";

     

       229
       229
       +
           `P "Download all attachments from an email:";

     

       230
       230
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 -o downloads/";

     

       231
       231
       +
           `P "";

     

       232
       232
       +
           `P "Download a specific blob:";

     

       233
       233
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -b blob456 -o downloads/";

     

       234
       234
       +
         ] in

     

       235
       235
       +
         

     

       236
       236
       +
         let cmd =

     

       237
       237
       +
           Cmd.v

     

       238
       238
       +
             (Cmd.info "jmap-blob-downloader" ~version:"1.0" ~doc ~man)

     

       239
       239
       +
             Term.(const download_command $ host_arg $ user_arg $ password_arg $ 

     

       240
       240
       +
                   email_id_arg $ blob_id_arg $ output_dir_arg $ list_only_arg)

     

       241
       241
       +
         in

     

       242
       242
       +
         cmd

     

       243
       243
       +
       

     

       244
       244
       +
       (* Main entry point *)

     

       245
       245
       +
       let () = exit (Cmd.eval' download_cmd)

+429

bin/jmap_email_composer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_email_composer.ml - Compose and send emails via JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's email creation and submission capabilities,

     

       5
       5
       +
        * including drafts, attachments, and sending.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Email composition options **)

     

       13
       13
       +
       type compose_options = {

     

       14
       14
       +
         to_recipients : string list;

     

       15
       15
       +
         cc_recipients : string list;

     

       16
       16
       +
         bcc_recipients : string list;

     

       17
       17
       +
         subject : string;

     

       18
       18
       +
         body_text : string option;

     

       19
       19
       +
         body_html : string option;

     

       20
       20
       +
         attachments : string list;

     

       21
       21
       +
         in_reply_to : string option;

     

       22
       22
       +
         draft : bool;

     

       23
       23
       +
         send : bool;

     

       24
       24
       +
       }

     

       25
       25
       +
       

     

       26
       26
       +
       (** Command-line arguments **)

     

       27
       27
       +
       

     

       28
       28
       +
       let host_arg =

     

       29
       29
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       30
       30
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       31
       31
       +
       

     

       32
       32
       +
       let user_arg =

     

       33
       33
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       34
       34
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       35
       35
       +
       

     

       36
       36
       +
       let password_arg =

     

       37
       37
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       38
       38
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       39
       39
       +
       

     

       40
       40
       +
       let to_arg =

     

       41
       41
       +
         Arg.(value & opt_all string [] & info ["t"; "to"] 

     

       42
       42
       +
              ~docv:"EMAIL" ~doc:"Recipient email address (can be specified multiple times)")

     

       43
       43
       +
       

     

       44
       44
       +
       let cc_arg =

     

       45
       45
       +
         Arg.(value & opt_all string [] & info ["c"; "cc"] 

     

       46
       46
       +
              ~docv:"EMAIL" ~doc:"CC recipient email address")

     

       47
       47
       +
       

     

       48
       48
       +
       let bcc_arg =

     

       49
       49
       +
         Arg.(value & opt_all string [] & info ["b"; "bcc"] 

     

       50
       50
       +
              ~docv:"EMAIL" ~doc:"BCC recipient email address")

     

       51
       51
       +
       

     

       52
       52
       +
       let subject_arg =

     

       53
       53
       +
         Arg.(required & opt (some string) None & info ["s"; "subject"] 

     

       54
       54
       +
              ~docv:"SUBJECT" ~doc:"Email subject line")

     

       55
       55
       +
       

     

       56
       56
       +
       let body_arg =

     

       57
       57
       +
         Arg.(value & opt (some string) None & info ["body"] 

     

       58
       58
       +
              ~docv:"TEXT" ~doc:"Plain text body content")

     

       59
       59
       +
       

     

       60
       60
       +
       let body_file_arg =

     

       61
       61
       +
         Arg.(value & opt (some string) None & info ["body-file"] 

     

       62
       62
       +
              ~docv:"FILE" ~doc:"Read body content from file")

     

       63
       63
       +
       

     

       64
       64
       +
       let html_arg =

     

       65
       65
       +
         Arg.(value & opt (some string) None & info ["html"] 

     

       66
       66
       +
              ~docv:"HTML" ~doc:"HTML body content")

     

       67
       67
       +
       

     

       68
       68
       +
       let html_file_arg =

     

       69
       69
       +
         Arg.(value & opt (some string) None & info ["html-file"] 

     

       70
       70
       +
              ~docv:"FILE" ~doc:"Read HTML body from file")

     

       71
       71
       +
       

     

       72
       72
       +
       let attach_arg =

     

       73
       73
       +
         Arg.(value & opt_all string [] & info ["a"; "attach"] 

     

       74
       74
       +
              ~docv:"FILE" ~doc:"File to attach (can be specified multiple times)")

     

       75
       75
       +
       

     

       76
       76
       +
       let reply_to_arg =

     

       77
       77
       +
         Arg.(value & opt (some string) None & info ["r"; "reply-to"] 

     

       78
       78
       +
              ~docv:"EMAIL_ID" ~doc:"Email ID to reply to")

     

       79
       79
       +
       

     

       80
       80
       +
       let draft_arg =

     

       81
       81
       +
         Arg.(value & flag & info ["d"; "draft"] 

     

       82
       82
       +
              ~doc:"Save as draft instead of sending")

     

       83
       83
       +
       

     

       84
       84
       +
       let send_arg =

     

       85
       85
       +
         Arg.(value & flag & info ["send"] 

     

       86
       86
       +
              ~doc:"Send the email immediately (default is to create draft)")

     

       87
       87
       +
       

     

       88
       88
       +
       (** Helper functions **)

     

       89
       89
       +
       

     

       90
       90
       +
       (* Read file contents *)

     

       91
       91
       +
       let read_file filename =

     

       92
       92
       +
         let ic = open_in filename in

     

       93
       93
       +
         let len = in_channel_length ic in

     

       94
       94
       +
         let content = really_input_string ic len in

     

       95
       95
       +
         close_in ic;

     

       96
       96
       +
         content

     

       97
       97
       +
       

     

       98
       98
       +
       (* Get MIME type from filename *)

     

       99
       99
       +
       let mime_type_from_filename filename =

     

       100
       100
       +
         match Filename.extension filename with

     

       101
       101
       +
         | ".pdf" -> "application/pdf"

     

       102
       102
       +
         | ".doc" | ".docx" -> "application/msword"

     

       103
       103
       +
         | ".xls" | ".xlsx" -> "application/vnd.ms-excel"

     

       104
       104
       +
         | ".jpg" | ".jpeg" -> "image/jpeg"

     

       105
       105
       +
         | ".png" -> "image/png"

     

       106
       106
       +
         | ".gif" -> "image/gif"

     

       107
       107
       +
         | ".txt" -> "text/plain"

     

       108
       108
       +
         | ".html" | ".htm" -> "text/html"

     

       109
       109
       +
         | ".zip" -> "application/zip"

     

       110
       110
       +
         | _ -> "application/octet-stream"

     

       111
       111
       +
       

     

       112
       112
       +
       (* Upload a file as a blob *)

     

       113
       113
       +
       let upload_attachment ctx session account_id filepath =

     

       114
       114
       +
         Printf.printf "Uploading %s...\n" filepath;

     

       115
       115
       +
         

     

       116
       116
       +
         let content = read_file filepath in

     

       117
       117
       +
         let filename = Filename.basename filepath in

     

       118
       118
       +
         let mime_type = mime_type_from_filename filename in

     

       119
       119
       +
         

     

       120
       120
       +
         (* Upload blob using the JMAP upload endpoint *)

     

       121
       121
       +
         let upload_url = Jmap.Session.Session.upload_url session in

     

       122
       122
       +
         let upload_endpoint = Printf.sprintf "%s/%s" (Uri.to_string upload_url) account_id in

     

       123
       123
       +
         

     

       124
       124
       +
         (* Simulate blob upload for type checking *)

     

       125
       125
       +
         Printf.printf "  Would upload to: %s\n" upload_endpoint;

     

       126
       126
       +
         Printf.printf "  Simulating upload of %s (%s, %d bytes)...\n" filename mime_type (String.length content);

     

       127
       127
       +
         

     

       128
       128
       +
         (* Create simulated blob info *)

     

       129
       129
       +
         let blob_info = Jmap.Binary.Upload_response.v

     

       130
       130
       +
           ~account_id:""

     

       131
       131
       +
           ~blob_id:("blob-" ^ filename ^ "-" ^ string_of_int (Random.int 99999))

     

       132
       132
       +
           ~type_:mime_type

     

       133
       133
       +
           ~size:(String.length content)

     

       134
       134
       +
           () in

     

       135
       135
       +
         Printf.printf "  Uploaded: %s (blob: %s, %d bytes)\n" 

     

       136
       136
       +
           filename 

     

       137
       137
       +
           (Jmap.Binary.Upload_response.blob_id blob_info)

     

       138
       138
       +
           (Jmap.Binary.Upload_response.size blob_info);

     

       139
       139
       +
         Ok blob_info

     

       140
       140
       +
       

     

       141
       141
       +
       (* Create email body parts *)

     

       142
       142
       +
       let create_body_parts options attachment_blobs =

     

       143
       143
       +
         let parts = ref [] in

     

       144
       144
       +
         

     

       145
       145
       +
         (* Add text body if provided *)

     

       146
       146
       +
         (match options.body_text with

     

       147
       147
       +
         | Some text ->

     

       148
       148
       +
             let text_part = Jmap_email.Types.Email_body_part.v

     

       149
       149
       +
               ~id:"text"

     

       150
       150
       +
               ~size:(String.length text)

     

       151
       151
       +
               ~headers:[]

     

       152
       152
       +
               ~mime_type:"text/plain"

     

       153
       153
       +
               ~charset:"utf-8"

     

       154
       154
       +
               () in

     

       155
       155
       +
             parts := text_part :: !parts

     

       156
       156
       +
         | None -> ());

     

       157
       157
       +
         

     

       158
       158
       +
         (* Add HTML body if provided *)

     

       159
       159
       +
         (match options.body_html with

     

       160
       160
       +
         | Some html ->

     

       161
       161
       +
             let html_part = Jmap_email.Types.Email_body_part.v

     

       162
       162
       +
               ~id:"html"

     

       163
       163
       +
               ~size:(String.length html)

     

       164
       164
       +
               ~headers:[]

     

       165
       165
       +
               ~mime_type:"text/html"

     

       166
       166
       +
               ~charset:"utf-8"

     

       167
       167
       +
               () in

     

       168
       168
       +
             parts := html_part :: !parts

     

       169
       169
       +
         | None -> ());

     

       170
       170
       +
         

     

       171
       171
       +
         (* Add attachments *)

     

       172
       172
       +
         List.iter2 (fun filepath blob_info ->

     

       173
       173
       +
           let filename = Filename.basename filepath in

     

       174
       174
       +
           let mime_type = mime_type_from_filename filename in

     

       175
       175
       +
           let attachment = Jmap_email.Types.Email_body_part.v

     

       176
       176
       +
             ~blob_id:(Jmap.Binary.Upload_response.blob_id blob_info)

     

       177
       177
       +
             ~size:(Jmap.Binary.Upload_response.size blob_info)

     

       178
       178
       +
             ~headers:[]

     

       179
       179
       +
             ~name:filename

     

       180
       180
       +
             ~mime_type

     

       181
       181
       +
             ~disposition:"attachment"

     

       182
       182
       +
             () in

     

       183
       183
       +
           parts := attachment :: !parts

     

       184
       184
       +
         ) options.attachments attachment_blobs;

     

       185
       185
       +
         

     

       186
       186
       +
         List.rev !parts

     

       187
       187
       +
       

     

       188
       188
       +
       (* Main compose and send function *)

     

       189
       189
       +
       let compose_and_send ctx session account_id options =

     

       190
       190
       +
         (* 1. Upload attachments first *)

     

       191
       191
       +
         let attachment_results = List.map (fun filepath ->

     

       192
       192
       +
           upload_attachment ctx session account_id filepath

     

       193
       193
       +
         ) options.attachments in

     

       194
       194
       +
         

     

       195
       195
       +
         let attachment_blobs = List.filter_map (function

     

       196
       196
       +
           | Ok blob -> Some blob

     

       197
       197
       +
           | Error () -> None

     

       198
       198
       +
         ) attachment_results in

     

       199
       199
       +
         

     

       200
       200
       +
         if List.length attachment_blobs < List.length options.attachments then (

     

       201
       201
       +
           Printf.eprintf "Warning: Some attachments failed to upload\n"

     

       202
       202
       +
         );

     

       203
       203
       +
         

     

       204
       204
       +
         (* 2. Create the email addresses *)

     

       205
       205
       +
         let to_addresses = List.map (fun email ->

     

       206
       206
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       207
       207
       +
         ) options.to_recipients in

     

       208
       208
       +
         

     

       209
       209
       +
         let cc_addresses = List.map (fun email ->

     

       210
       210
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       211
       211
       +
         ) options.cc_recipients in

     

       212
       212
       +
         

     

       213
       213
       +
         let bcc_addresses = List.map (fun email ->

     

       214
       214
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       215
       215
       +
         ) options.bcc_recipients in

     

       216
       216
       +
         

     

       217
       217
       +
         (* 3. Get sender identity *)

     

       218
       218
       +
         let identity_args = Jmap.Methods.Get_args.v

     

       219
       219
       +
           ~account_id

     

       220
       220
       +
           ~properties:["id"; "email"; "name"]

     

       221
       221
       +
           () in

     

       222
       222
       +
           

     

       223
       223
       +
         let identity_invocation = Jmap.Wire.Invocation.v

     

       224
       224
       +
           ~method_name:"Identity/get"

     

       225
       225
       +
           ~arguments:(`Assoc []) (* Would serialize identity_args *)

     

       226
       226
       +
           ~method_call_id:"id1"

     

       227
       227
       +
           () in

     

       228
       228
       +
           

     

       229
       229
       +
         let request = Jmap.Wire.Request.v

     

       230
       230
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       231
       231
       +
           ~method_calls:[identity_invocation]

     

       232
       232
       +
           () in

     

       233
       233
       +
           

     

       234
       234
       +
         let default_identity = match Jmap_unix.request ctx request with

     

       235
       235
       +
           | Ok _ ->

     

       236
       236
       +
               (* Would extract from response *)

     

       237
       237
       +
               Jmap_email.Identity.v

     

       238
       238
       +
                 ~id:"identity1"

     

       239
       239
       +
                 ~email:account_id

     

       240
       240
       +
                 ~name:"User Name"

     

       241
       241
       +
                 ~may_delete:true

     

       242
       242
       +
                 ()

     

       243
       243
       +
           | Error _ ->

     

       244
       244
       +
               (* Fallback identity *)

     

       245
       245
       +
               Jmap_email.Identity.v

     

       246
       246
       +
                 ~id:"identity1"

     

       247
       247
       +
                 ~email:account_id

     

       248
       248
       +
                 ~may_delete:true

     

       249
       249
       +
                 ()

     

       250
       250
       +
         in

     

       251
       251
       +
         

     

       252
       252
       +
         (* 4. Create the draft email *)

     

       253
       253
       +
         let body_parts = create_body_parts options attachment_blobs in

     

       254
       254
       +
         

     

       255
       255
       +
         let draft_email = Jmap_email.Types.Email.create

     

       256
       256
       +
           ~subject:options.subject

     

       257
       257
       +
           ~from:[Jmap_email.Types.Email_address.v 

     

       258
       258
       +
                    ~email:(Jmap_email.Identity.email default_identity)

     

       259
       259
       +
                    ~name:(Jmap_email.Identity.name default_identity)

     

       260
       260
       +
                    ()]

     

       261
       261
       +
           ~to_:to_addresses

     

       262
       262
       +
           ~cc:cc_addresses

     

       263
       263
       +
           ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Draft])

     

       264
       264
       +
           ~text_body:body_parts

     

       265
       265
       +
           () in

     

       266
       266
       +
           

     

       267
       267
       +
         (* 5. Create the email using Email/set *)

     

       268
       268
       +
         let create_map = Hashtbl.create 1 in

     

       269
       269
       +
         Hashtbl.add create_map "draft1" draft_email;

     

       270
       270
       +
         

     

       271
       271
       +
         let create_args = Jmap.Methods.Set_args.v

     

       272
       272
       +
           ~account_id

     

       273
       273
       +
           ~create:create_map

     

       274
       274
       +
           () in

     

       275
       275
       +
           

     

       276
       276
       +
         let create_invocation = Jmap.Wire.Invocation.v

     

       277
       277
       +
           ~method_name:"Email/set"

     

       278
       278
       +
           ~arguments:(`Assoc []) (* Would serialize create_args *)

     

       279
       279
       +
           ~method_call_id:"create1"

     

       280
       280
       +
           () in

     

       281
       281
       +
           

     

       282
       282
       +
         (* 6. If sending, also create EmailSubmission *)

     

       283
       283
       +
         let method_calls = if options.send && not options.draft then

     

       284
       284
       +
           let submission = {

     

       285
       285
       +
             Jmap_email.Submission.email_sub_create_identity_id = Jmap_email.Identity.id default_identity;

     

       286
       286
       +
             email_sub_create_email_id = "#draft1"; (* Back-reference to created email *)

     

       287
       287
       +
             email_sub_create_envelope = None;

     

       288
       288
       +
           } in

     

       289
       289
       +
             

     

       290
       290
       +
           let submit_map = Hashtbl.create 1 in

     

       291
       291
       +
           Hashtbl.add submit_map "submission1" submission;

     

       292
       292
       +
           

     

       293
       293
       +
           let submit_args = Jmap.Methods.Set_args.v

     

       294
       294
       +
             ~account_id

     

       295
       295
       +
             ~create:submit_map

     

       296
       296
       +
             () in

     

       297
       297
       +
             

     

       298
       298
       +
           let submit_invocation = Jmap.Wire.Invocation.v

     

       299
       299
       +
             ~method_name:"EmailSubmission/set"

     

       300
       300
       +
             ~arguments:(`Assoc []) (* Would serialize submit_args *)

     

       301
       301
       +
             ~method_call_id:"submit1"

     

       302
       302
       +
             () in

     

       303
       303
       +
             

     

       304
       304
       +
           [create_invocation; submit_invocation]

     

       305
       305
       +
         else

     

       306
       306
       +
           [create_invocation]

     

       307
       307
       +
         in

     

       308
       308
       +
         

     

       309
       309
       +
         (* 7. Send the request *)

     

       310
       310
       +
         let request = Jmap.Wire.Request.v

     

       311
       311
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_submission]

     

       312
       312
       +
           ~method_calls

     

       313
       313
       +
           () in

     

       314
       314
       +
           

     

       315
       315
       +
         match Jmap_unix.request ctx request with

     

       316
       316
       +
         | Ok response ->

     

       317
       317
       +
             if options.send && not options.draft then

     

       318
       318
       +
               Printf.printf "\nEmail sent successfully!\n"

     

       319
       319
       +
             else

     

       320
       320
       +
               Printf.printf "\nDraft saved successfully!\n";

     

       321
       321
       +
             0

     

       322
       322
       +
         | Error e ->

     

       323
       323
       +
             Printf.eprintf "\nFailed to create email: %s\n" (Jmap.Error.error_to_string e);

     

       324
       324
       +
             1

     

       325
       325
       +
       

     

       326
       326
       +
       (* Command implementation *)

     

       327
       327
       +
       let compose_command host user password to_list cc_list bcc_list subject 

     

       328
       328
       +
                           body body_file html html_file attachments reply_to 

     

       329
       329
       +
                           draft send : int =

     

       330
       330
       +
         Printf.printf "JMAP Email Composer\n";

     

       331
       331
       +
         Printf.printf "Server: %s\n" host;

     

       332
       332
       +
         Printf.printf "User: %s\n\n" user;

     

       333
       333
       +
         

     

       334
       334
       +
         (* Validate arguments *)

     

       335
       335
       +
         if to_list = [] && cc_list = [] && bcc_list = [] then (

     

       336
       336
       +
           Printf.eprintf "Error: Must specify at least one recipient\n";

     

       337
       337
       +
           exit 1

     

       338
       338
       +
         );

     

       339
       339
       +
         

     

       340
       340
       +
         (* Read body content *)

     

       341
       341
       +
         let body_text = match body, body_file with

     

       342
       342
       +
           | Some text, _ -> Some text

     

       343
       343
       +
           | None, Some file -> Some (read_file file)

     

       344
       344
       +
           | None, None -> None

     

       345
       345
       +
         in

     

       346
       346
       +
         

     

       347
       347
       +
         let body_html = match html, html_file with

     

       348
       348
       +
           | Some text, _ -> Some text

     

       349
       349
       +
           | None, Some file -> Some (read_file file)

     

       350
       350
       +
           | None, None -> None

     

       351
       351
       +
         in

     

       352
       352
       +
         

     

       353
       353
       +
         if body_text = None && body_html = None then (

     

       354
       354
       +
           Printf.eprintf "Error: Must provide email body (--body, --body-file, --html, or --html-file)\n";

     

       355
       355
       +
           exit 1

     

       356
       356
       +
         );

     

       357
       357
       +
         

     

       358
       358
       +
         (* Create options record *)

     

       359
       359
       +
         let options = {

     

       360
       360
       +
           to_recipients = to_list;

     

       361
       361
       +
           cc_recipients = cc_list;

     

       362
       362
       +
           bcc_recipients = bcc_list;

     

       363
       363
       +
           subject;

     

       364
       364
       +
           body_text;

     

       365
       365
       +
           body_html;

     

       366
       366
       +
           attachments;

     

       367
       367
       +
           in_reply_to = reply_to;

     

       368
       368
       +
           draft;

     

       369
       369
       +
           send = send || not draft; (* Send by default unless draft flag is set *)

     

       370
       370
       +
         } in

     

       371
       371
       +
         

     

       372
       372
       +
         (* Connect to server *)

     

       373
       373
       +
         let ctx = Jmap_unix.create_client () in

     

       374
       374
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       375
       375
       +
         

     

       376
       376
       +
         let (ctx, session) = match result with

     

       377
       377
       +
           | Ok (ctx, session) -> (ctx, session)

     

       378
       378
       +
           | Error e -> 

     

       379
       379
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       380
       380
       +
               exit 1

     

       381
       381
       +
         in

     

       382
       382
       +
         

     

       383
       383
       +
         (* Get the primary account ID *)

     

       384
       384
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       385
       385
       +
           | Ok id -> id

     

       386
       386
       +
           | Error e -> 

     

       387
       387
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       388
       388
       +
               exit 1

     

       389
       389
       +
         in

     

       390
       390
       +
         

     

       391
       391
       +
         (* Compose and send/save the email *)

     

       392
       392
       +
         compose_and_send ctx session account_id options

     

       393
       393
       +
       

     

       394
       394
       +
       (* Command definition *)

     

       395
       395
       +
       let compose_cmd =

     

       396
       396
       +
         let doc = "compose and send emails via JMAP" in

     

       397
       397
       +
         let man = [

     

       398
       398
       +
           `S Manpage.s_description;

     

       399
       399
       +
           `P "Compose and send emails using the JMAP protocol.";

     

       400
       400
       +
           `P "Supports plain text and HTML bodies, attachments, and drafts.";

     

       401
       401
       +
           `S Manpage.s_examples;

     

       402
       402
       +
           `P "Send a simple email:";

     

       403
       403
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       404
       404
       +
           `P "    -t recipient@example.com -s \"Meeting reminder\" \\";

     

       405
       405
       +
           `P "    --body \"Don't forget our meeting at 3pm!\"";

     

       406
       406
       +
           `P "";

     

       407
       407
       +
           `P "Send email with attachment:";

     

       408
       408
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       409
       409
       +
           `P "    -t recipient@example.com -s \"Report attached\" \\";

     

       410
       410
       +
           `P "    --body-file message.txt -a report.pdf";

     

       411
       411
       +
           `P "";

     

       412
       412
       +
           `P "Save as draft:";

     

       413
       413
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       414
       414
       +
           `P "    -t recipient@example.com -s \"Work in progress\" \\";

     

       415
       415
       +
           `P "    --body \"Still working on this...\" --draft";

     

       416
       416
       +
         ] in

     

       417
       417
       +
         

     

       418
       418
       +
         let cmd =

     

       419
       419
       +
           Cmd.v

     

       420
       420
       +
             (Cmd.info "jmap-email-composer" ~version:"1.0" ~doc ~man)

     

       421
       421
       +
             Term.(const compose_command $ host_arg $ user_arg $ password_arg $ 

     

       422
       422
       +
                   to_arg $ cc_arg $ bcc_arg $ subject_arg $ body_arg $ body_file_arg $

     

       423
       423
       +
                   html_arg $ html_file_arg $ attach_arg $ reply_to_arg $ 

     

       424
       424
       +
                   draft_arg $ send_arg)

     

       425
       425
       +
         in

     

       426
       426
       +
         cmd

     

       427
       427
       +
       

     

       428
       428
       +
       (* Main entry point *)

     

       429
       429
       +
       let () = exit (Cmd.eval' compose_cmd)

+436

bin/jmap_email_search.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_email_search.ml - A comprehensive email search utility using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's query capabilities for email searching,

     

       5
       5
       +
        * filtering, and sorting.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Email search arguments type *)

     

       13
       13
       +
       type email_search_args = {

     

       14
       14
       +
         query : string;

     

       15
       15
       +
         from : string option;

     

       16
       16
       +
         to_ : string option;

     

       17
       17
       +
         subject : string option;

     

       18
       18
       +
         before : string option;

     

       19
       19
       +
         after : string option;

     

       20
       20
       +
         has_attachment : bool;

     

       21
       21
       +
         mailbox : string option;

     

       22
       22
       +
         is_unread : bool;

     

       23
       23
       +
         limit : int;

     

       24
       24
       +
         sort : [`DateDesc | `DateAsc | `From | `To | `Subject | `Size];

     

       25
       25
       +
         format : [`Summary | `Json | `Detailed];

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       (* Module to convert ISO 8601 date strings to Unix timestamps *)

     

       29
       29
       +
       module Date_converter = struct

     

       30
       30
       +
         (* Convert an ISO date string (YYYY-MM-DD) to Unix timestamp *)

     

       31
       31
       +
         let parse_date date_str =

     

       32
       32
       +
           try

     

       33
       33
       +
             (* Parse YYYY-MM-DD format *)

     

       34
       34
       +
             let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in

     

       35
       35
       +
             

     

       36
       36
       +
             (* Convert to Unix timestamp (midnight UTC of that day) *)

     

       37
       37
       +
             let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
                             tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;

     

       39
       39
       +
                             tm_wday = 0; tm_yday = 0; tm_isdst = false } in

     

       40
       40
       +
             Some (Unix.mktime tm |> fst)

     

       41
       41
       +
           with _ ->

     

       42
       42
       +
             Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;

     

       43
       43
       +
             None

     

       44
       44
       +
             

     

       45
       45
       +
         (* Format a Unix timestamp as ISO 8601 *)

     

       46
       46
       +
         let format_datetime time =

     

       47
       47
       +
           let tm = Unix.gmtime time in

     

       48
       48
       +
           Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"

     

       49
       49
       +
             (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       50
       50
       +
             tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec

     

       51
       51
       +
       end

     

       52
       52
       +
       

     

       53
       53
       +
       (** Command-line arguments **)

     

       54
       54
       +
       

     

       55
       55
       +
       let host_arg =

     

       56
       56
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       57
       57
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       58
       58
       +
       

     

       59
       59
       +
       let user_arg =

     

       60
       60
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       61
       61
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       62
       62
       +
       

     

       63
       63
       +
       let password_arg =

     

       64
       64
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       65
       65
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       66
       66
       +
       

     

       67
       67
       +
       let query_arg =

     

       68
       68
       +
         Arg.(value & opt string "" & info ["q"; "query"] 

     

       69
       69
       +
              ~docv:"QUERY" ~doc:"Text to search for in emails")

     

       70
       70
       +
       

     

       71
       71
       +
       let from_arg =

     

       72
       72
       +
         Arg.(value & opt (some string) None & info ["from"] 

     

       73
       73
       +
              ~docv:"EMAIL" ~doc:"Filter by sender email address")

     

       74
       74
       +
       

     

       75
       75
       +
       let to_arg =

     

       76
       76
       +
         Arg.(value & opt (some string) None & info ["to"] 

     

       77
       77
       +
              ~docv:"EMAIL" ~doc:"Filter by recipient email address")

     

       78
       78
       +
       

     

       79
       79
       +
       let subject_arg =

     

       80
       80
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       81
       81
       +
              ~docv:"SUBJECT" ~doc:"Filter by subject text")

     

       82
       82
       +
       

     

       83
       83
       +
       let before_arg =

     

       84
       84
       +
         Arg.(value & opt (some string) None & info ["before"] 

     

       85
       85
       +
              ~docv:"DATE" ~doc:"Show emails before date (YYYY-MM-DD)")

     

       86
       86
       +
       

     

       87
       87
       +
       let after_arg =

     

       88
       88
       +
         Arg.(value & opt (some string) None & info ["after"] 

     

       89
       89
       +
              ~docv:"DATE" ~doc:"Show emails after date (YYYY-MM-DD)")

     

       90
       90
       +
       

     

       91
       91
       +
       let has_attachment_arg =

     

       92
       92
       +
         Arg.(value & flag & info ["has-attachment"] 

     

       93
       93
       +
              ~doc:"Filter to emails with attachments")

     

       94
       94
       +
       

     

       95
       95
       +
       let mailbox_arg =

     

       96
       96
       +
         Arg.(value & opt (some string) None & info ["mailbox"] 

     

       97
       97
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox name")

     

       98
       98
       +
       

     

       99
       99
       +
       let is_unread_arg =

     

       100
       100
       +
         Arg.(value & flag & info ["unread"] 

     

       101
       101
       +
              ~doc:"Show only unread emails")

     

       102
       102
       +
       

     

       103
       103
       +
       let limit_arg =

     

       104
       104
       +
         Arg.(value & opt int 20 & info ["limit"] 

     

       105
       105
       +
              ~docv:"N" ~doc:"Maximum number of results to return")

     

       106
       106
       +
       

     

       107
       107
       +
       let sort_arg =

     

       108
       108
       +
         Arg.(value & opt (enum [

     

       109
       109
       +
           "date-desc", `DateDesc;

     

       110
       110
       +
           "date-asc", `DateAsc;

     

       111
       111
       +
           "from", `From;

     

       112
       112
       +
           "to", `To;

     

       113
       113
       +
           "subject", `Subject;

     

       114
       114
       +
           "size", `Size;

     

       115
       115
       +
         ]) `DateDesc & info ["sort"] ~docv:"FIELD" 

     

       116
       116
       +
              ~doc:"Sort results by field")

     

       117
       117
       +
       

     

       118
       118
       +
       let format_arg =

     

       119
       119
       +
         Arg.(value & opt (enum [

     

       120
       120
       +
           "summary", `Summary;

     

       121
       121
       +
           "json", `Json;

     

       122
       122
       +
           "detailed", `Detailed;

     

       123
       123
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" 

     

       124
       124
       +
              ~doc:"Output format")

     

       125
       125
       +
       

     

       126
       126
       +
       (** Main functionality **)

     

       127
       127
       +
       

     

       128
       128
       +
       (* Create a filter based on command-line arguments - this function uses the actual JMAP API *)

     

       129
       129
       +
       let create_filter _account_id mailbox_id_opt args =

     

       130
       130
       +
         let open Jmap.Methods.Filter in

     

       131
       131
       +
         let filters = [] in

     

       132
       132
       +
         

     

       133
       133
       +
         (* Add filter conditions based on command-line args *)

     

       134
       134
       +
         let filters = match args.query with 

     

       135
       135
       +
           | "" -> filters 

     

       136
       136
       +
           | query -> Jmap_email.Email_filter.subject query :: filters 

     

       137
       137
       +
         in

     

       138
       138
       +
         

     

       139
       139
       +
         let filters = match args.from with

     

       140
       140
       +
           | None -> filters

     

       141
       141
       +
           | Some sender -> Jmap_email.Email_filter.from sender :: filters

     

       142
       142
       +
         in

     

       143
       143
       +
         

     

       144
       144
       +
         let filters = match args.to_ with

     

       145
       145
       +
           | None -> filters

     

       146
       146
       +
           | Some recipient -> Jmap_email.Email_filter.to_ recipient :: filters

     

       147
       147
       +
         in

     

       148
       148
       +
         

     

       149
       149
       +
         let filters = match args.subject with

     

       150
       150
       +
           | None -> filters

     

       151
       151
       +
           | Some subj -> Jmap_email.Email_filter.subject subj :: filters

     

       152
       152
       +
         in

     

       153
       153
       +
         

     

       154
       154
       +
         let filters = match args.before with

     

       155
       155
       +
           | None -> filters

     

       156
       156
       +
           | Some date_str -> 

     

       157
       157
       +
               match Date_converter.parse_date date_str with

     

       158
       158
       +
               | Some date -> Jmap_email.Email_filter.before date :: filters

     

       159
       159
       +
               | None -> filters

     

       160
       160
       +
         in

     

       161
       161
       +
         

     

       162
       162
       +
         let filters = match args.after with

     

       163
       163
       +
           | None -> filters

     

       164
       164
       +
           | Some date_str -> 

     

       165
       165
       +
               match Date_converter.parse_date date_str with

     

       166
       166
       +
               | Some date -> Jmap_email.Email_filter.after date :: filters

     

       167
       167
       +
               | None -> filters

     

       168
       168
       +
         in

     

       169
       169
       +
         

     

       170
       170
       +
         let filters = if args.has_attachment then Jmap_email.Email_filter.has_attachment () :: filters else filters in

     

       171
       171
       +
         

     

       172
       172
       +
         let filters = if args.is_unread then Jmap_email.Email_filter.unread () :: filters else filters in

     

       173
       173
       +
         

     

       174
       174
       +
         let filters = match mailbox_id_opt with

     

       175
       175
       +
           | None -> filters

     

       176
       176
       +
           | Some mailbox_id -> Jmap_email.Email_filter.in_mailbox mailbox_id :: filters

     

       177
       177
       +
         in

     

       178
       178
       +
         

     

       179
       179
       +
         (* Combine all filters with AND *)

     

       180
       180
       +
         match filters with

     

       181
       181
       +
         | [] -> condition (`Assoc [])  (* Empty filter *)

     

       182
       182
       +
         | [f] -> f

     

       183
       183
       +
         | filters -> and_ filters

     

       184
       184
       +
       

     

       185
       185
       +
       (* Create sort comparator based on command-line arguments *)

     

       186
       186
       +
       let create_sort args =

     

       187
       187
       +
         match args.sort with

     

       188
       188
       +
         | `DateDesc -> Jmap_email.Email_sort.received_newest_first ()

     

       189
       189
       +
         | `DateAsc -> Jmap_email.Email_sort.received_oldest_first ()

     

       190
       190
       +
         | `From -> Jmap_email.Email_sort.from_asc ()

     

       191
       191
       +
         | `To -> Jmap_email.Email_sort.subject_asc ()  (* Using subject as proxy for 'to' *)

     

       192
       192
       +
         | `Subject -> Jmap_email.Email_sort.subject_asc ()

     

       193
       193
       +
         | `Size -> Jmap_email.Email_sort.size_largest_first ()

     

       194
       194
       +
       

     

       195
       195
       +
       (* Display email results based on format option *)

     

       196
       196
       +
       let display_results emails format =

     

       197
       197
       +
         match format with

     

       198
       198
       +
         | `Summary ->

     

       199
       199
       +
             emails |> List.iteri (fun i email ->

     

       200
       200
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in

     

       201
       201
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in

     

       202
       202
       +
               let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in

     

       203
       203
       +
               let from = match from_list with

     

       204
       204
       +
                 | [] -> "(no sender)"

     

       205
       205
       +
                 | addr::_ -> Jmap_email.Types.Email_address.email addr

     

       206
       206
       +
               in

     

       207
       207
       +
               let date = match Jmap_email.Types.Email.received_at email with

     

       208
       208
       +
                 | Some d -> Date_converter.format_datetime d

     

       209
       209
       +
                 | None -> "(no date)"

     

       210
       210
       +
               in

     

       211
       211
       +
               Printf.printf "%3d) [%s] %s\n     From: %s\n     Date: %s\n\n" 

     

       212
       212
       +
                 (i+1) id subject from date

     

       213
       213
       +
             );

     

       214
       214
       +
             0

     

       215
       215
       +
         

     

       216
       216
       +
         | `Detailed ->

     

       217
       217
       +
             emails |> List.iteri (fun i email ->

     

       218
       218
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in

     

       219
       219
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in

     

       220
       220
       +
               let thread_id = Option.value (Jmap_email.Types.Email.thread_id email) ~default:"(no thread)" in

     

       221
       221
       +
               

     

       222
       222
       +
               let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in

     

       223
       223
       +
               let from = match from_list with

     

       224
       224
       +
                 | [] -> "(no sender)"

     

       225
       225
       +
                 | addr::_ -> Jmap_email.Types.Email_address.email addr

     

       226
       226
       +
               in

     

       227
       227
       +
               

     

       228
       228
       +
               let to_list = Option.value (Jmap_email.Types.Email.to_ email) ~default:[] in

     

       229
       229
       +
               let to_str = to_list 

     

       230
       230
       +
                 |> List.map Jmap_email.Types.Email_address.email

     

       231
       231
       +
                 |> String.concat ", " in

     

       232
       232
       +
               

     

       233
       233
       +
               let date = match Jmap_email.Types.Email.received_at email with

     

       234
       234
       +
                 | Some d -> Date_converter.format_datetime d

     

       235
       235
       +
                 | None -> "(no date)"

     

       236
       236
       +
               in

     

       237
       237
       +
               

     

       238
       238
       +
               let keywords = match Jmap_email.Types.Email.keywords email with

     

       239
       239
       +
                 | Some kw -> Jmap_email.Types.Keywords.custom_keywords kw 

     

       240
       240
       +
                              |> String.concat ", "

     

       241
       241
       +
                 | None -> "(none)"

     

       242
       242
       +
               in

     

       243
       243
       +
               

     

       244
       244
       +
               let has_attachment = match Jmap_email.Types.Email.has_attachment email with

     

       245
       245
       +
                 | Some true -> "Yes"

     

       246
       246
       +
                 | _ -> "No"

     

       247
       247
       +
               in

     

       248
       248
       +
               

     

       249
       249
       +
               Printf.printf "Email %d:\n" (i+1);

     

       250
       250
       +
               Printf.printf "  ID:        %s\n" id;

     

       251
       251
       +
               Printf.printf "  Subject:   %s\n" subject;

     

       252
       252
       +
               Printf.printf "  From:      %s\n" from;

     

       253
       253
       +
               Printf.printf "  To:        %s\n" to_str;

     

       254
       254
       +
               Printf.printf "  Date:      %s\n" date;

     

       255
       255
       +
               Printf.printf "  Thread:    %s\n" thread_id;

     

       256
       256
       +
               Printf.printf "  Flags:     %s\n" keywords;

     

       257
       257
       +
               Printf.printf "  Attachment:%s\n" has_attachment;

     

       258
       258
       +
               

     

       259
       259
       +
               match Jmap_email.Types.Email.preview email with

     

       260
       260
       +
               | Some text -> Printf.printf "  Preview:   %s\n" text

     

       261
       261
       +
               | None -> ();

     

       262
       262
       +
               

     

       263
       263
       +
               Printf.printf "\n"

     

       264
       264
       +
             );

     

       265
       265
       +
             0

     

       266
       266
       +
             

     

       267
       267
       +
         | `Json ->

     

       268
       268
       +
             (* In a real implementation, this would properly convert emails to JSON *)

     

       269
       269
       +
             Printf.printf "{\n  \"results\": [\n";

     

       270
       270
       +
             emails |> List.iteri (fun i email ->

     

       271
       271
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"" in

     

       272
       272
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"" in

     

       273
       273
       +
               Printf.printf "    {\"id\": \"%s\", \"subject\": \"%s\"%s\n" 

     

       274
       274
       +
                 id subject (if i < List.length emails - 1 then "}," else "}")

     

       275
       275
       +
             );

     

       276
       276
       +
             Printf.printf "  ]\n}\n";

     

       277
       277
       +
             0

     

       278
       278
       +
       

     

       279
       279
       +
       (* Command implementation - using the real JMAP interface *)

     

       280
       280
       +
       let search_command host user password query from to_ subject before after 

     

       281
       281
       +
                          has_attachment mailbox is_unread limit sort format : int =

     

       282
       282
       +
         (* Pack arguments into a record for easier passing *)

     

       283
       283
       +
         let args : email_search_args = {

     

       284
       284
       +
           query; from; to_ = to_; subject; before; after; 

     

       285
       285
       +
           has_attachment; mailbox; is_unread; limit; sort; format

     

       286
       286
       +
         } in

     

       287
       287
       +
         

     

       288
       288
       +
         Printf.printf "JMAP Email Search\n";

     

       289
       289
       +
         Printf.printf "Server: %s\n" host;

     

       290
       290
       +
         Printf.printf "User: %s\n\n" user;

     

       291
       291
       +
         

     

       292
       292
       +
         (* The following code demonstrates using the JMAP library interface

     

       293
       293
       +
            but doesn't actually run it for Step 2 (it will get a linker error,

     

       294
       294
       +
            which is expected since there's no implementation yet) *)

     

       295
       295
       +
         

     

       296
       296
       +
         let process_search () =

     

       297
       297
       +
           (* 1. Create client context and connect to server *)

     

       298
       298
       +
           let _orig_ctx = Jmap_unix.create_client () in

     

       299
       299
       +
           let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       300
       300
       +
           

     

       301
       301
       +
           let (ctx, session) = match result with

     

       302
       302
       +
             | Ok (ctx, session) -> (ctx, session)

     

       303
       303
       +
             | Error _ -> failwith "Could not connect to server"

     

       304
       304
       +
           in

     

       305
       305
       +
           

     

       306
       306
       +
           (* 2. Get the primary account ID for mail capability *)

     

       307
       307
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       308
       308
       +
             | Ok id -> id

     

       309
       309
       +
             | Error _ -> failwith "No mail account found"

     

       310
       310
       +
           in

     

       311
       311
       +
           

     

       312
       312
       +
           (* 3. Resolve mailbox name to ID if specified *)

     

       313
       313
       +
           let mailbox_id_opt = match args.mailbox with

     

       314
       314
       +
             | None -> None

     

       315
       315
       +
             | Some _name ->

     

       316
       316
       +
                 (* This would use Mailbox/query and Mailbox/get to resolve the name *)

     

       317
       317
       +
                 (* For now just simulate a mailbox ID *)

     

       318
       318
       +
                 Some "mailbox123"

     

       319
       319
       +
           in

     

       320
       320
       +
           

     

       321
       321
       +
           (* 4. Create filter based on search criteria *)

     

       322
       322
       +
           let filter = create_filter account_id mailbox_id_opt args in

     

       323
       323
       +
           

     

       324
       324
       +
           (* 5. Create sort comparator *)

     

       325
       325
       +
           let sort = create_sort args in

     

       326
       326
       +
           

     

       327
       327
       +
           (* 6. Prepare Email/query request *)

     

       328
       328
       +
           let _query_args = Jmap.Methods.Query_args.v

     

       329
       329
       +
             ~account_id

     

       330
       330
       +
             ~filter

     

       331
       331
       +
             ~sort:[sort]

     

       332
       332
       +
             ~position:0

     

       333
       333
       +
             ~limit:args.limit

     

       334
       334
       +
             ~calculate_total:true

     

       335
       335
       +
             () in

     

       336
       336
       +
             

     

       337
       337
       +
           let query_invocation = Jmap.Wire.Invocation.v

     

       338
       338
       +
             ~method_name:"Email/query"

     

       339
       339
       +
             ~arguments:(`Assoc []) (* In real code, we'd serialize query_args to JSON *)

     

       340
       340
       +
             ~method_call_id:"q1"

     

       341
       341
       +
             () in

     

       342
       342
       +
           

     

       343
       343
       +
           (* 7. Prepare Email/get request with back-reference to query results *)

     

       344
       344
       +
           let get_properties = [

     

       345
       345
       +
             "id"; "threadId"; "mailboxIds"; "keywords"; "size";

     

       346
       346
       +
             "receivedAt"; "messageId"; "inReplyTo"; "references";

     

       347
       347
       +
             "sender"; "from"; "to"; "cc"; "bcc"; "replyTo";

     

       348
       348
       +
             "subject"; "sentAt"; "hasAttachment"; "preview" 

     

       349
       349
       +
           ] in

     

       350
       350
       +
           

     

       351
       351
       +
           let _get_args = Jmap.Methods.Get_args.v

     

       352
       352
       +
             ~account_id

     

       353
       353
       +
             ~properties:get_properties

     

       354
       354
       +
             () in

     

       355
       355
       +
           

     

       356
       356
       +
           let get_invocation = Jmap.Wire.Invocation.v

     

       357
       357
       +
             ~method_name:"Email/get"

     

       358
       358
       +
             ~arguments:(`Assoc []) (* In real code, we'd serialize get_args to JSON *)

     

       359
       359
       +
             ~method_call_id:"g1"

     

       360
       360
       +
             () in

     

       361
       361
       +
           

     

       362
       362
       +
           (* 8. Prepare the JMAP request *)

     

       363
       363
       +
           let request = Jmap.Wire.Request.v

     

       364
       364
       +
             ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       365
       365
       +
             ~method_calls:[query_invocation; get_invocation]

     

       366
       366
       +
             () in

     

       367
       367
       +
           

     

       368
       368
       +
           (* 9. Send the request *)

     

       369
       369
       +
           let response = match Jmap_unix.request ctx request with

     

       370
       370
       +
             | Ok response -> response

     

       371
       371
       +
             | Error _ -> failwith "Request failed"

     

       372
       372
       +
           in

     

       373
       373
       +
           

     

       374
       374
       +
           (* Helper to find a method response by ID *)

     

       375
       375
       +
           let find_method_response response id =

     

       376
       376
       +
             let open Jmap.Wire in

     

       377
       377
       +
             let responses = Response.method_responses response in

     

       378
       378
       +
             let find_by_id inv =

     

       379
       379
       +
               match inv with

     

       380
       380
       +
               | Ok invocation when Invocation.method_call_id invocation = id -> 

     

       381
       381
       +
                   Some (Invocation.method_name invocation, Invocation.arguments invocation)

     

       382
       382
       +
               | _ -> None

     

       383
       383
       +
             in

     

       384
       384
       +
             List.find_map find_by_id responses

     

       385
       385
       +
           in

     

       386
       386
       +
           

     

       387
       387
       +
           (* 10. Process the response *)

     

       388
       388
       +
           match find_method_response response "g1" with

     

       389
       389
       +
           | Some (method_name, _) when method_name = "Email/get" ->

     

       390
       390
       +
               (* We would extract the emails from the response here *)

     

       391
       391
       +
               (* For now, just create a sample email for type checking *)

     

       392
       392
       +
               let email = Jmap_email.Types.Email.create

     

       393
       393
       +
                 ~id:"email123"

     

       394
       394
       +
                 ~thread_id:"thread456"

     

       395
       395
       +
                 ~subject:"Test Email"

     

       396
       396
       +
                 ~from:[Jmap_email.Types.Email_address.v ~name:"Sender" ~email:"sender@example.com" ()]

     

       397
       397
       +
                 ~to_:[Jmap_email.Types.Email_address.v ~name:"Recipient" ~email:"recipient@example.com" ()]

     

       398
       398
       +
                 ~received_at:1588000000.0

     

       399
       399
       +
                 ~has_attachment:true

     

       400
       400
       +
                 ~preview:"This is a test email..."

     

       401
       401
       +
                 ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Seen])

     

       402
       402
       +
                 () in

     

       403
       403
       +
                 

     

       404
       404
       +
               (* Display the result *)

     

       405
       405
       +
               display_results [email] args.format

     

       406
       406
       +
           | _ ->

     

       407
       407
       +
               Printf.eprintf "Error: Invalid response\n";

     

       408
       408
       +
               1

     

       409
       409
       +
         in

     

       410
       410
       +
         

     

       411
       411
       +
         (* Note: Since we're only type checking, this won't actually run *)

     

       412
       412
       +
         process_search ()

     

       413
       413
       +
       

     

       414
       414
       +
       (* Command definition *)

     

       415
       415
       +
       let search_cmd =

     

       416
       416
       +
         let doc = "search emails using JMAP query capabilities" in

     

       417
       417
       +
         let man = [

     

       418
       418
       +
           `S Manpage.s_description;

     

       419
       419
       +
           `P "Searches for emails on a JMAP server with powerful filtering capabilities.";

     

       420
       420
       +
           `P "Demonstrates the rich query functions available in the JMAP protocol.";

     

       421
       421
       +
           `S Manpage.s_examples;

     

       422
       422
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -q \"important meeting\"";

     

       423
       423
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --from boss@company.com --after 2023-01-01";

     

       424
       424
       +
         ] in

     

       425
       425
       +
         

     

       426
       426
       +
         let cmd =

     

       427
       427
       +
           Cmd.v

     

       428
       428
       +
             (Cmd.info "jmap-email-search" ~version:"1.0" ~doc ~man)

     

       429
       429
       +
             Term.(const search_command $ host_arg $ user_arg $ password_arg $ 

     

       430
       430
       +
                   query_arg $ from_arg $ to_arg $ subject_arg $ before_arg $ after_arg $ 

     

       431
       431
       +
                   has_attachment_arg $ mailbox_arg $ is_unread_arg $ limit_arg $ sort_arg $ format_arg)

     

       432
       432
       +
         in

     

       433
       433
       +
         cmd

     

       434
       434
       +
       

     

       435
       435
       +
       (* Main entry point *)

     

       436
       436
       +
       let () = exit (Cmd.eval' search_cmd)

+706

bin/jmap_flag_manager.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_flag_manager.ml - A tool for managing email flags (keywords) using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's flag management capabilities, allowing

     

       5
       5
       +
        * powerful query-based selection and batch flag operations.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap.Methods

     

       13
       13
       +
       open Jmap_email

     

       14
       14
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       15
       15
       +
       

     

       16
       16
       +
       (* Dummy Unix module for type checking *)

     

       17
       17
       +
       module Unix = struct

     

       18
       18
       +
         type tm = {

     

       19
       19
       +
           tm_sec : int;

     

       20
       20
       +
           tm_min : int;

     

       21
       21
       +
           tm_hour : int;

     

       22
       22
       +
           tm_mday : int;

     

       23
       23
       +
           tm_mon : int;

     

       24
       24
       +
           tm_year : int;

     

       25
       25
       +
           tm_wday : int;

     

       26
       26
       +
           tm_yday : int;

     

       27
       27
       +
           tm_isdst : bool

     

       28
       28
       +
         }

     

       29
       29
       +
         

     

       30
       30
       +
         let time () = 0.0

     

       31
       31
       +
         let gettimeofday () = 0.0

     

       32
       32
       +
         let mktime tm = (0.0, tm)

     

       33
       33
       +
         let gmtime _time = {

     

       34
       34
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       35
       35
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       36
       36
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       37
       37
       +
         }

     

       38
       38
       +
         

     

       39
       39
       +
         (* JMAP connection function - would be in a real implementation *)

     

       40
       40
       +
         let connect ~host:_ ~username:_ ~password:_ ?auth_method:_ () =

     

       41
       41
       +
           failwith "Not implemented"

     

       42
       42
       +
       end

     

       43
       43
       +
       

     

       44
       44
       +
       (* Dummy ISO8601 module *)

     

       45
       45
       +
       module ISO8601 = struct

     

       46
       46
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       47
       47
       +
       end

     

       48
       48
       +
       

     

       49
       49
       +
       (** Flag manager args type *)

     

       50
       50
       +
       type flag_manager_args = {

     

       51
       51
       +
         list : bool;

     

       52
       52
       +
         add_flag : string option;

     

       53
       53
       +
         remove_flag : string option;

     

       54
       54
       +
         query : string;

     

       55
       55
       +
         from : string option;

     

       56
       56
       +
         days : int;

     

       57
       57
       +
         mailbox : string option;

     

       58
       58
       +
         ids : string list;

     

       59
       59
       +
         has_flag : string option;

     

       60
       60
       +
         missing_flag : string option;

     

       61
       61
       +
         limit : int;

     

       62
       62
       +
         dry_run : bool;

     

       63
       63
       +
         color : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option;

     

       64
       64
       +
         verbose : bool;

     

       65
       65
       +
       }

     

       66
       66
       +
       

     

       67
       67
       +
       (* Helper function for converting keywords to string *)

     

       68
       68
       +
       let string_of_keyword = function

     

       69
       69
       +
         | Types.Keywords.Draft -> "$draft"

     

       70
       70
       +
         | Types.Keywords.Seen -> "$seen"

     

       71
       71
       +
         | Types.Keywords.Flagged -> "$flagged"

     

       72
       72
       +
         | Types.Keywords.Answered -> "$answered"

     

       73
       73
       +
         | Types.Keywords.Forwarded -> "$forwarded"

     

       74
       74
       +
         | Types.Keywords.Phishing -> "$phishing"

     

       75
       75
       +
         | Types.Keywords.Junk -> "$junk"

     

       76
       76
       +
         | Types.Keywords.NotJunk -> "$notjunk"

     

       77
       77
       +
         | Types.Keywords.Custom c -> c

     

       78
       78
       +
         | Types.Keywords.Notify -> "$notify"

     

       79
       79
       +
         | Types.Keywords.Muted -> "$muted"

     

       80
       80
       +
         | Types.Keywords.Followed -> "$followed"

     

       81
       81
       +
         | Types.Keywords.Memo -> "$memo" 

     

       82
       82
       +
         | Types.Keywords.HasMemo -> "$hasmemo"

     

       83
       83
       +
         | Types.Keywords.Autosent -> "$autosent"

     

       84
       84
       +
         | Types.Keywords.Unsubscribed -> "$unsubscribed"

     

       85
       85
       +
         | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"

     

       86
       86
       +
         | Types.Keywords.Imported -> "$imported"

     

       87
       87
       +
         | Types.Keywords.IsTrusted -> "$istrusted"

     

       88
       88
       +
         | Types.Keywords.MaskedEmail -> "$maskedemail"

     

       89
       89
       +
         | Types.Keywords.New -> "$new"

     

       90
       90
       +
         | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"

     

       91
       91
       +
         | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1" 

     

       92
       92
       +
         | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"

     

       93
       93
       +
       

     

       94
       94
       +
       (* Email filter helpers - stub implementations for type checking *)

     

       95
       95
       +
       module Email_filter = struct

     

       96
       96
       +
         let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])

     

       97
       97
       +
         let subject subject = Filter.condition (`Assoc [("subject", `String subject)])

     

       98
       98
       +
         let from email = Filter.condition (`Assoc [("from", `String email)])

     

       99
       99
       +
         let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])

     

       100
       100
       +
         let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])

     

       101
       101
       +
         let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])

     

       102
       102
       +
         let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])

     

       103
       103
       +
         let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])

     

       104
       104
       +
         let to_ email = Filter.condition (`Assoc [("to", `String email)])

     

       105
       105
       +
         let has_keyword kw = Filter.condition (`Assoc [("hasKeyword", `String (string_of_keyword kw))])

     

       106
       106
       +
         let not_has_keyword kw = Filter.condition (`Assoc [("notHasKeyword", `String (string_of_keyword kw))])

     

       107
       107
       +
       end

     

       108
       108
       +
       

     

       109
       109
       +
       (** Command-line arguments **)

     

       110
       110
       +
       

     

       111
       111
       +
       let host_arg =

     

       112
       112
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       113
       113
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       114
       114
       +
       

     

       115
       115
       +
       let user_arg =

     

       116
       116
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       117
       117
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       118
       118
       +
       

     

       119
       119
       +
       let password_arg =

     

       120
       120
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       121
       121
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       122
       122
       +
       

     

       123
       123
       +
       let list_arg =

     

       124
       124
       +
         Arg.(value & flag & info ["l"; "list"] ~doc:"List emails with their flags")

     

       125
       125
       +
       

     

       126
       126
       +
       let add_flag_arg =

     

       127
       127
       +
         Arg.(value & opt (some string) None & info ["add"] 

     

       128
       128
       +
              ~docv:"FLAG" ~doc:"Add flag to selected emails")

     

       129
       129
       +
       

     

       130
       130
       +
       let remove_flag_arg =

     

       131
       131
       +
         Arg.(value & opt (some string) None & info ["remove"] 

     

       132
       132
       +
              ~docv:"FLAG" ~doc:"Remove flag from selected emails")

     

       133
       133
       +
       

     

       134
       134
       +
       let query_arg =

     

       135
       135
       +
         Arg.(value & opt string "" & info ["q"; "query"] 

     

       136
       136
       +
              ~docv:"QUERY" ~doc:"Filter emails by search query")

     

       137
       137
       +
       

     

       138
       138
       +
       let from_arg =

     

       139
       139
       +
         Arg.(value & opt (some string) None & info ["from"] 

     

       140
       140
       +
              ~docv:"EMAIL" ~doc:"Filter by sender")

     

       141
       141
       +
       

     

       142
       142
       +
       let days_arg =

     

       143
       143
       +
         Arg.(value & opt int 30 & info ["days"] 

     

       144
       144
       +
              ~docv:"DAYS" ~doc:"Filter to emails from past N days")

     

       145
       145
       +
       

     

       146
       146
       +
       let mailbox_arg =

     

       147
       147
       +
         Arg.(value & opt (some string) None & info ["mailbox"] 

     

       148
       148
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox")

     

       149
       149
       +
       

     

       150
       150
       +
       let ids_arg =

     

       151
       151
       +
         Arg.(value & opt_all string [] & info ["id"] 

     

       152
       152
       +
              ~docv:"ID" ~doc:"Email IDs to operate on")

     

       153
       153
       +
       

     

       154
       154
       +
       let has_flag_arg =

     

       155
       155
       +
         Arg.(value & opt (some string) None & info ["has-flag"] 

     

       156
       156
       +
              ~docv:"FLAG" ~doc:"Filter to emails with specified flag")

     

       157
       157
       +
       

     

       158
       158
       +
       let missing_flag_arg =

     

       159
       159
       +
         Arg.(value & opt (some string) None & info ["missing-flag"] 

     

       160
       160
       +
              ~docv:"FLAG" ~doc:"Filter to emails without specified flag")

     

       161
       161
       +
       

     

       162
       162
       +
       let limit_arg =

     

       163
       163
       +
         Arg.(value & opt int 50 & info ["limit"] 

     

       164
       164
       +
              ~docv:"N" ~doc:"Maximum number of emails to process")

     

       165
       165
       +
       

     

       166
       166
       +
       let dry_run_arg =

     

       167
       167
       +
         Arg.(value & flag & info ["dry-run"] ~doc:"Show what would be done without making changes")

     

       168
       168
       +
       

     

       169
       169
       +
       let color_arg =

     

       170
       170
       +
         Arg.(value & opt (some (enum [

     

       171
       171
       +
           "red", `Red;

     

       172
       172
       +
           "orange", `Orange;

     

       173
       173
       +
           "yellow", `Yellow;

     

       174
       174
       +
           "green", `Green;

     

       175
       175
       +
           "blue", `Blue;

     

       176
       176
       +
           "purple", `Purple;

     

       177
       177
       +
           "gray", `Gray;

     

       178
       178
       +
           "none", `None

     

       179
       179
       +
         ])) None & info ["color"] ~docv:"COLOR" 

     

       180
       180
       +
              ~doc:"Set color flag (red, orange, yellow, green, blue, purple, gray, or none)")

     

       181
       181
       +
       

     

       182
       182
       +
       let verbose_arg =

     

       183
       183
       +
         Arg.(value & flag & info ["v"; "verbose"] ~doc:"Show detailed operation information")

     

       184
       184
       +
       

     

       185
       185
       +
       (** Flag Manager Functionality **)

     

       186
       186
       +
       

     

       187
       187
       +
       (* Parse date for filtering *)

     

       188
       188
       +
       let days_ago_date days =

     

       189
       189
       +
         let now = Unix.time () in

     

       190
       190
       +
         now -. (float_of_int days *. 86400.0)

     

       191
       191
       +
       

     

       192
       192
       +
       (* Validate flag name *)

     

       193
       193
       +
       let validate_flag_name flag =

     

       194
       194
       +
         let is_valid = String.length flag > 0 && (

     

       195
       195
       +
           (* System flags start with $ *)

     

       196
       196
       +
           (String.get flag 0 = '$') ||

     

       197
       197
       +
           

     

       198
       198
       +
           (* Custom flags must be alphanumeric plus some characters *)

     

       199
       199
       +
           (String.for_all (function 

     

       200
       200
       +
             | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' -> true 

     

       201
       201
       +
             | _ -> false) flag)

     

       202
       202
       +
         ) in

     

       203
       203
       +
         

     

       204
       204
       +
         if not is_valid then

     

       205
       205
       +
           Printf.eprintf "Warning: Flag name '%s' may not be valid according to JMAP spec\n" flag;

     

       206
       206
       +
         

     

       207
       207
       +
         is_valid

     

       208
       208
       +
       

     

       209
       209
       +
       (* Convert flag name to keyword *)

     

       210
       210
       +
       let flag_to_keyword flag =

     

       211
       211
       +
         match flag with

     

       212
       212
       +
         | "seen" -> Types.Keywords.Seen

     

       213
       213
       +
         | "draft" -> Types.Keywords.Draft

     

       214
       214
       +
         | "flagged" -> Types.Keywords.Flagged

     

       215
       215
       +
         | "answered" -> Types.Keywords.Answered

     

       216
       216
       +
         | "forwarded" -> Types.Keywords.Forwarded

     

       217
       217
       +
         | "junk" -> Types.Keywords.Junk

     

       218
       218
       +
         | "notjunk" -> Types.Keywords.NotJunk

     

       219
       219
       +
         | "phishing" -> Types.Keywords.Phishing

     

       220
       220
       +
         | "important" -> Types.Keywords.Flagged  (* Treat important same as flagged *)

     

       221
       221
       +
         | _ -> 

     

       222
       222
       +
             (* Handle $ prefix for system keywords *)

     

       223
       223
       +
             if String.get flag 0 = '$' then

     

       224
       224
       +
               match flag with

     

       225
       225
       +
               | "$seen" -> Types.Keywords.Seen

     

       226
       226
       +
               | "$draft" -> Types.Keywords.Draft

     

       227
       227
       +
               | "$flagged" -> Types.Keywords.Flagged

     

       228
       228
       +
               | "$answered" -> Types.Keywords.Answered

     

       229
       229
       +
               | "$forwarded" -> Types.Keywords.Forwarded

     

       230
       230
       +
               | "$junk" -> Types.Keywords.Junk

     

       231
       231
       +
               | "$notjunk" -> Types.Keywords.NotJunk

     

       232
       232
       +
               | "$phishing" -> Types.Keywords.Phishing

     

       233
       233
       +
               | "$notify" -> Types.Keywords.Notify

     

       234
       234
       +
               | "$muted" -> Types.Keywords.Muted

     

       235
       235
       +
               | "$followed" -> Types.Keywords.Followed

     

       236
       236
       +
               | "$memo" -> Types.Keywords.Memo

     

       237
       237
       +
               | "$hasmemo" -> Types.Keywords.HasMemo

     

       238
       238
       +
               | "$autosent" -> Types.Keywords.Autosent

     

       239
       239
       +
               | "$unsubscribed" -> Types.Keywords.Unsubscribed

     

       240
       240
       +
               | "$canunsubscribe" -> Types.Keywords.CanUnsubscribe

     

       241
       241
       +
               | "$imported" -> Types.Keywords.Imported

     

       242
       242
       +
               | "$istrusted" -> Types.Keywords.IsTrusted

     

       243
       243
       +
               | "$maskedemail" -> Types.Keywords.MaskedEmail

     

       244
       244
       +
               | "$new" -> Types.Keywords.New

     

       245
       245
       +
               | "$MailFlagBit0" -> Types.Keywords.MailFlagBit0

     

       246
       246
       +
               | "$MailFlagBit1" -> Types.Keywords.MailFlagBit1

     

       247
       247
       +
               | "$MailFlagBit2" -> Types.Keywords.MailFlagBit2

     

       248
       248
       +
               | _ -> Types.Keywords.Custom flag

     

       249
       249
       +
             else

     

       250
       250
       +
               (* Flag without $ prefix is treated as custom *)

     

       251
       251
       +
               Types.Keywords.Custom ("$" ^ flag)

     

       252
       252
       +
       

     

       253
       253
       +
       (* Get standard flags in user-friendly format *)

     

       254
       254
       +
       let get_standard_flags () = [

     

       255
       255
       +
         "seen", "Message has been read";

     

       256
       256
       +
         "draft", "Message is a draft";

     

       257
       257
       +
         "flagged", "Message is flagged/important";

     

       258
       258
       +
         "answered", "Message has been replied to";

     

       259
       259
       +
         "forwarded", "Message has been forwarded";

     

       260
       260
       +
         "junk", "Message is spam/junk";

     

       261
       261
       +
         "notjunk", "Message is explicitly not spam/junk";

     

       262
       262
       +
         "phishing", "Message is suspected phishing";

     

       263
       263
       +
         "notify", "Request notification when replied to";

     

       264
       264
       +
         "muted", "Notifications disabled for this message";

     

       265
       265
       +
         "followed", "Thread is followed for notifications";

     

       266
       266
       +
         "memo", "Has memo/note attached";

     

       267
       267
       +
         "new", "Recently delivered";

     

       268
       268
       +
       ]

     

       269
       269
       +
       

     

       270
       270
       +
       (* Convert color to flag bits *)

     

       271
       271
       +
       let color_to_flags color =

     

       272
       272
       +
         match color with

     

       273
       273
       +
         | `Red -> [Types.Keywords.MailFlagBit0]

     

       274
       274
       +
         | `Orange -> [Types.Keywords.MailFlagBit1]

     

       275
       275
       +
         | `Yellow -> [Types.Keywords.MailFlagBit2]

     

       276
       276
       +
         | `Green -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1]

     

       277
       277
       +
         | `Blue -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit2]

     

       278
       278
       +
         | `Purple -> [Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]

     

       279
       279
       +
         | `Gray -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]

     

       280
       280
       +
         | `None -> []

     

       281
       281
       +
       

     

       282
       282
       +
       (* Convert flag bits to color *)

     

       283
       283
       +
       let flags_to_color flags =

     

       284
       284
       +
         let has_bit0 = List.exists ((=) Types.Keywords.MailFlagBit0) flags in

     

       285
       285
       +
         let has_bit1 = List.exists ((=) Types.Keywords.MailFlagBit1) flags in

     

       286
       286
       +
         let has_bit2 = List.exists ((=) Types.Keywords.MailFlagBit2) flags in

     

       287
       287
       +
         

     

       288
       288
       +
         match (has_bit0, has_bit1, has_bit2) with

     

       289
       289
       +
         | (true, false, false) -> Some `Red

     

       290
       290
       +
         | (false, true, false) -> Some `Orange

     

       291
       291
       +
         | (false, false, true) -> Some `Yellow

     

       292
       292
       +
         | (true, true, false) -> Some `Green

     

       293
       293
       +
         | (true, false, true) -> Some `Blue

     

       294
       294
       +
         | (false, true, true) -> Some `Purple

     

       295
       295
       +
         | (true, true, true) -> Some `Gray

     

       296
       296
       +
         | (false, false, false) -> None

     

       297
       297
       +
       

     

       298
       298
       +
       (* Filter builder - create JMAP filter from command line args *)

     

       299
       299
       +
       let build_filter account_id mailbox_id args =

     

       300
       300
       +
         let open Email_filter in

     

       301
       301
       +
         let filters = [] in

     

       302
       302
       +
         

     

       303
       303
       +
         (* Add filter conditions based on command-line args *)

     

       304
       304
       +
         let filters = match args.query with 

     

       305
       305
       +
           | "" -> filters 

     

       306
       306
       +
           | query -> create_fulltext_filter query :: filters 

     

       307
       307
       +
         in

     

       308
       308
       +
         

     

       309
       309
       +
         let filters = match args.from with

     

       310
       310
       +
           | None -> filters

     

       311
       311
       +
           | Some sender -> from sender :: filters

     

       312
       312
       +
         in

     

       313
       313
       +
         

     

       314
       314
       +
         let filters = 

     

       315
       315
       +
           if args.days > 0 then 

     

       316
       316
       +
             after (days_ago_date args.days) :: filters

     

       317
       317
       +
           else 

     

       318
       318
       +
             filters

     

       319
       319
       +
         in

     

       320
       320
       +
         

     

       321
       321
       +
         let filters = match mailbox_id with

     

       322
       322
       +
           | None -> filters

     

       323
       323
       +
           | Some id -> in_mailbox id :: filters

     

       324
       324
       +
         in

     

       325
       325
       +
         

     

       326
       326
       +
         let filters = match args.has_flag with

     

       327
       327
       +
           | None -> filters

     

       328
       328
       +
           | Some flag -> 

     

       329
       329
       +
               let kw = flag_to_keyword flag in

     

       330
       330
       +
               has_keyword kw :: filters

     

       331
       331
       +
         in

     

       332
       332
       +
         

     

       333
       333
       +
         let filters = match args.missing_flag with

     

       334
       334
       +
           | None -> filters

     

       335
       335
       +
           | Some flag ->

     

       336
       336
       +
               let kw = flag_to_keyword flag in

     

       337
       337
       +
               not_has_keyword kw :: filters

     

       338
       338
       +
         in

     

       339
       339
       +
         

     

       340
       340
       +
         (* Combine all filters with AND *)

     

       341
       341
       +
         match filters with

     

       342
       342
       +
         | [] -> Filter.condition (`Assoc [])  (* Empty filter *)

     

       343
       343
       +
         | [f] -> f

     

       344
       344
       +
         | filters -> Filter.and_ filters

     

       345
       345
       +
       

     

       346
       346
       +
       (* Display email flag information *)

     

       347
       347
       +
       let display_email_flags emails verbose =

     

       348
       348
       +
         Printf.printf "Emails and their flags:\n\n";

     

       349
       349
       +
         

     

       350
       350
       +
         emails |> List.iteri (fun i email ->

     

       351
       351
       +
           let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       352
       352
       +
           let subject = Option.value (Types.Email.subject email) ~default:"(no subject)" in

     

       353
       353
       +
           

     

       354
       354
       +
           let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       355
       355
       +
           let from = match from_list with

     

       356
       356
       +
             | addr :: _ -> Types.Email_address.email addr

     

       357
       357
       +
             | [] -> "(unknown)"

     

       358
       358
       +
           in

     

       359
       359
       +
           

     

       360
       360
       +
           let date = match Types.Email.received_at email with

     

       361
       361
       +
             | Some d -> String.sub (ISO8601.string_of_datetime (Unix.gmtime d)) 0 19

     

       362
       362
       +
             | None -> "(unknown)"

     

       363
       363
       +
           in

     

       364
       364
       +
           

     

       365
       365
       +
           (* Get all keywords/flags *)

     

       366
       366
       +
           let keywords = match Types.Email.keywords email with

     

       367
       367
       +
             | Some kw -> kw

     

       368
       368
       +
             | None -> []

     

       369
       369
       +
           in

     

       370
       370
       +
           

     

       371
       371
       +
           (* Format keywords for display *)

     

       372
       372
       +
           let flag_strs = keywords |> List.map (fun kw ->

     

       373
       373
       +
             match kw with

     

       374
       374
       +
             | Types.Keywords.Draft -> "$draft"

     

       375
       375
       +
             | Types.Keywords.Seen -> "$seen"

     

       376
       376
       +
             | Types.Keywords.Flagged -> "$flagged"

     

       377
       377
       +
             | Types.Keywords.Answered -> "$answered"

     

       378
       378
       +
             | Types.Keywords.Forwarded -> "$forwarded"

     

       379
       379
       +
             | Types.Keywords.Phishing -> "$phishing"

     

       380
       380
       +
             | Types.Keywords.Junk -> "$junk"

     

       381
       381
       +
             | Types.Keywords.NotJunk -> "$notjunk"

     

       382
       382
       +
             | Types.Keywords.Custom c -> c

     

       383
       383
       +
             | Types.Keywords.Notify -> "$notify"

     

       384
       384
       +
             | Types.Keywords.Muted -> "$muted"

     

       385
       385
       +
             | Types.Keywords.Followed -> "$followed"

     

       386
       386
       +
             | Types.Keywords.Memo -> "$memo" 

     

       387
       387
       +
             | Types.Keywords.HasMemo -> "$hasmemo"

     

       388
       388
       +
             | Types.Keywords.Autosent -> "$autosent"

     

       389
       389
       +
             | Types.Keywords.Unsubscribed -> "$unsubscribed"

     

       390
       390
       +
             | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"

     

       391
       391
       +
             | Types.Keywords.Imported -> "$imported"

     

       392
       392
       +
             | Types.Keywords.IsTrusted -> "$istrusted"

     

       393
       393
       +
             | Types.Keywords.MaskedEmail -> "$maskedemail"

     

       394
       394
       +
             | Types.Keywords.New -> "$new"

     

       395
       395
       +
             | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"

     

       396
       396
       +
             | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1" 

     

       397
       397
       +
             | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"

     

       398
       398
       +
           ) in

     

       399
       399
       +
           

     

       400
       400
       +
           Printf.printf "Email %d: %s\n" (i + 1) subject;

     

       401
       401
       +
           Printf.printf "  ID:    %s\n" id;

     

       402
       402
       +
           

     

       403
       403
       +
           if verbose then begin

     

       404
       404
       +
             Printf.printf "  From:  %s\n" from;

     

       405
       405
       +
             Printf.printf "  Date:  %s\n" date;

     

       406
       406
       +
           end;

     

       407
       407
       +
           

     

       408
       408
       +
           (* Show color if applicable *)

     

       409
       409
       +
           begin match flags_to_color keywords with

     

       410
       410
       +
           | Some color ->

     

       411
       411
       +
               let color_name = match color with

     

       412
       412
       +
                 | `Red -> "Red"

     

       413
       413
       +
                 | `Orange -> "Orange"

     

       414
       414
       +
                 | `Yellow -> "Yellow" 

     

       415
       415
       +
                 | `Green -> "Green"

     

       416
       416
       +
                 | `Blue -> "Blue"

     

       417
       417
       +
                 | `Purple -> "Purple"

     

       418
       418
       +
                 | `Gray -> "Gray"

     

       419
       419
       +
               in

     

       420
       420
       +
               Printf.printf "  Color: %s\n" color_name

     

       421
       421
       +
           | None -> ()

     

       422
       422
       +
           end;

     

       423
       423
       +
           

     

       424
       424
       +
           Printf.printf "  Flags: %s\n\n" 

     

       425
       425
       +
             (if flag_strs = [] then "(none)" else String.concat ", " flag_strs)

     

       426
       426
       +
         );

     

       427
       427
       +
         

     

       428
       428
       +
         if List.length emails = 0 then

     

       429
       429
       +
           Printf.printf "No emails found matching criteria.\n"

     

       430
       430
       +
       

     

       431
       431
       +
       (* Command implementation *)

     

       432
       432
       +
       let flag_command host user _password list add_flag remove_flag query from days 

     

       433
       433
       +
                         mailbox ids has_flag missing_flag limit dry_run color verbose : int =

     

       434
       434
       +
         (* Pack arguments into a record for easier passing *)

     

       435
       435
       +
         let _args : flag_manager_args = {

     

       436
       436
       +
           list; add_flag; remove_flag; query; from; days; mailbox; 

     

       437
       437
       +
           ids; has_flag; missing_flag; limit; dry_run; color; verbose

     

       438
       438
       +
         } in

     

       439
       439
       +
         

     

       440
       440
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       441
       441
       +
         Printf.printf "JMAP Flag Manager\n";

     

       442
       442
       +
         Printf.printf "Server: %s\n" host;

     

       443
       443
       +
         Printf.printf "User: %s\n\n" user;

     

       444
       444
       +
         

     

       445
       445
       +
         if list then

     

       446
       446
       +
           Printf.printf "Listing emails with their flags...\n\n"

     

       447
       447
       +
         else begin

     

       448
       448
       +
           if add_flag <> None then

     

       449
       449
       +
             Printf.printf "Adding flag: %s\n" (Option.get add_flag);

     

       450
       450
       +
           

     

       451
       451
       +
           if remove_flag <> None then

     

       452
       452
       +
             Printf.printf "Removing flag: %s\n" (Option.get remove_flag);

     

       453
       453
       +
           

     

       454
       454
       +
           if color <> None then

     

       455
       455
       +
             let color_name = match Option.get color with

     

       456
       456
       +
               | `Red -> "Red"

     

       457
       457
       +
               | `Orange -> "Orange"

     

       458
       458
       +
               | `Yellow -> "Yellow" 

     

       459
       459
       +
               | `Green -> "Green"

     

       460
       460
       +
               | `Blue -> "Blue"

     

       461
       461
       +
               | `Purple -> "Purple"

     

       462
       462
       +
               | `Gray -> "Gray"

     

       463
       463
       +
               | `None -> "None"

     

       464
       464
       +
             in

     

       465
       465
       +
             Printf.printf "Setting color: %s\n" color_name;

     

       466
       466
       +
         end;

     

       467
       467
       +
         

     

       468
       468
       +
         if query <> "" then

     

       469
       469
       +
           Printf.printf "Filtering by query: %s\n" query;

     

       470
       470
       +
         

     

       471
       471
       +
         if from <> None then

     

       472
       472
       +
           Printf.printf "Filtering by sender: %s\n" (Option.get from);

     

       473
       473
       +
         

     

       474
       474
       +
         if mailbox <> None then

     

       475
       475
       +
           Printf.printf "Filtering by mailbox: %s\n" (Option.get mailbox);

     

       476
       476
       +
         

     

       477
       477
       +
         if ids <> [] then

     

       478
       478
       +
           Printf.printf "Operating on specific email IDs: %s\n" 

     

       479
       479
       +
             (String.concat ", " ids);

     

       480
       480
       +
         

     

       481
       481
       +
         if has_flag <> None then

     

       482
       482
       +
           Printf.printf "Filtering to emails with flag: %s\n" (Option.get has_flag);

     

       483
       483
       +
         

     

       484
       484
       +
         if missing_flag <> None then

     

       485
       485
       +
           Printf.printf "Filtering to emails without flag: %s\n" (Option.get missing_flag);

     

       486
       486
       +
         

     

       487
       487
       +
         Printf.printf "Limiting to %d emails\n" limit;

     

       488
       488
       +
         

     

       489
       489
       +
         if dry_run then

     

       490
       490
       +
           Printf.printf "DRY RUN MODE - No changes will be made\n";

     

       491
       491
       +
         

     

       492
       492
       +
         Printf.printf "\n";

     

       493
       493
       +
         

     

       494
       494
       +
         (* This is where the actual JMAP calls would happen, like:

     

       495
       495
       +
         

     

       496
       496
       +
         let manage_flags () =

     

       497
       497
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       498
       498
       +
             ~host ~username:user ~password 

     

       499
       499
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       500
       500
       +
           

     

       501
       501
       +
           (* Get primary account ID *)

     

       502
       502
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       503
       503
       +
             | Ok id -> id

     

       504
       504
       +
             | Error _ -> failwith "No mail account found"

     

       505
       505
       +
           in

     

       506
       506
       +
           

     

       507
       507
       +
           (* Resolve mailbox name to ID if specified *)

     

       508
       508
       +
           let* mailbox_id_opt = match args.mailbox with

     

       509
       509
       +
             | None -> Lwt.return None

     

       510
       510
       +
             | Some name ->

     

       511
       511
       +
                 (* This would use Mailbox/query and Mailbox/get to resolve the name *)

     

       512
       512
       +
                 ...

     

       513
       513
       +
           in

     

       514
       514
       +
           

     

       515
       515
       +
           (* Find emails to operate on *)

     

       516
       516
       +
           let* emails = 

     

       517
       517
       +
             if args.ids <> [] then

     

       518
       518
       +
               (* Get emails by ID *)

     

       519
       519
       +
               let* result = Email.get ctx

     

       520
       520
       +
                 ~account_id

     

       521
       521
       +
                 ~ids:args.ids

     

       522
       522
       +
                 ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in

     

       523
       523
       +
               

     

       524
       524
       +
               match result with

     

       525
       525
       +
               | Error err ->

     

       526
       526
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       527
       527
       +
                   Lwt.return []

     

       528
       528
       +
               | Ok (_, emails) -> Lwt.return emails

     

       529
       529
       +
             else

     

       530
       530
       +
               (* Find emails by query *)

     

       531
       531
       +
               let filter = build_filter account_id mailbox_id_opt args in

     

       532
       532
       +
               

     

       533
       533
       +
               let* result = Email.query ctx

     

       534
       534
       +
                 ~account_id

     

       535
       535
       +
                 ~filter

     

       536
       536
       +
                 ~sort:[Email_sort.received_newest_first ()]

     

       537
       537
       +
                 ~limit:args.limit

     

       538
       538
       +
                 ~properties:["id"] in

     

       539
       539
       +
               

     

       540
       540
       +
               match result with

     

       541
       541
       +
               | Error err ->

     

       542
       542
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       543
       543
       +
                   Lwt.return []

     

       544
       544
       +
               | Ok (ids, _) ->

     

       545
       545
       +
                   (* Get full email objects for the matching IDs *)

     

       546
       546
       +
                   let* result = Email.get ctx

     

       547
       547
       +
                     ~account_id

     

       548
       548
       +
                     ~ids

     

       549
       549
       +
                     ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in

     

       550
       550
       +
                   

     

       551
       551
       +
                   match result with

     

       552
       552
       +
                   | Error err ->

     

       553
       553
       +
                       Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       554
       554
       +
                       Lwt.return []

     

       555
       555
       +
                   | Ok (_, emails) -> Lwt.return emails

     

       556
       556
       +
           in

     

       557
       557
       +
           

     

       558
       558
       +
           (* Just list the emails with their flags *)

     

       559
       559
       +
           if args.list then

     

       560
       560
       +
             display_email_flags emails args.verbose;

     

       561
       561
       +
             Lwt.return_unit

     

       562
       562
       +
           else if List.length emails = 0 then

     

       563
       563
       +
             Printf.printf "No emails found matching criteria.\n";

     

       564
       564
       +
             Lwt.return_unit

     

       565
       565
       +
           else

     

       566
       566
       +
             (* Perform flag operations *)

     

       567
       567
       +
             let ids = emails |> List.filter_map Types.Email.id in

     

       568
       568
       +
             

     

       569
       569
       +
             if args.dry_run then

     

       570
       570
       +
               display_email_flags emails args.verbose;

     

       571
       571
       +
               Lwt.return_unit

     

       572
       572
       +
             else

     

       573
       573
       +
               (* Create patch object *)

     

       574
       574
       +
               let make_patch () =

     

       575
       575
       +
                 let add_keywords = ref [] in

     

       576
       576
       +
                 let remove_keywords = ref [] in

     

       577
       577
       +
                 

     

       578
       578
       +
                 (* Handle add flag *)

     

       579
       579
       +
                 Option.iter (fun flag ->

     

       580
       580
       +
                   let keyword = flag_to_keyword flag in

     

       581
       581
       +
                   add_keywords := keyword :: !add_keywords

     

       582
       582
       +
                 ) args.add_flag;

     

       583
       583
       +
                 

     

       584
       584
       +
                 (* Handle remove flag *)

     

       585
       585
       +
                 Option.iter (fun flag ->

     

       586
       586
       +
                   let keyword = flag_to_keyword flag in

     

       587
       587
       +
                   remove_keywords := keyword :: !remove_keywords

     

       588
       588
       +
                 ) args.remove_flag;

     

       589
       589
       +
                 

     

       590
       590
       +
                 (* Handle color *)

     

       591
       591
       +
                 Option.iter (fun color ->

     

       592
       592
       +
                   (* First remove all color bits *)

     

       593
       593
       +
                   remove_keywords := Types.Keywords.MailFlagBit0 :: !remove_keywords;

     

       594
       594
       +
                   remove_keywords := Types.Keywords.MailFlagBit1 :: !remove_keywords;

     

       595
       595
       +
                   remove_keywords := Types.Keywords.MailFlagBit2 :: !remove_keywords;

     

       596
       596
       +
                   

     

       597
       597
       +
                   (* Then add the right combination for the requested color *)

     

       598
       598
       +
                   if color <> `None then begin

     

       599
       599
       +
                     let color_flags = color_to_flags color in

     

       600
       600
       +
                     add_keywords := color_flags @ !add_keywords

     

       601
       601
       +
                   end

     

       602
       602
       +
                 ) args.color;

     

       603
       603
       +
                 

     

       604
       604
       +
                 Email.make_patch

     

       605
       605
       +
                   ~add_keywords:!add_keywords

     

       606
       606
       +
                   ~remove_keywords:!remove_keywords

     

       607
       607
       +
                   ()

     

       608
       608
       +
               in

     

       609
       609
       +
               

     

       610
       610
       +
               let patch = make_patch () in

     

       611
       611
       +
               

     

       612
       612
       +
               let* result = Email.update ctx

     

       613
       613
       +
                 ~account_id

     

       614
       614
       +
                 ~ids

     

       615
       615
       +
                 ~update_each:(fun _ -> patch) in

     

       616
       616
       +
               

     

       617
       617
       +
               match result with

     

       618
       618
       +
               | Error err ->

     

       619
       619
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       620
       620
       +
                   Lwt.return_unit

     

       621
       621
       +
               | Ok updated ->

     

       622
       622
       +
                   Printf.printf "Successfully updated %d emails.\n" (List.length updated);

     

       623
       623
       +
                   Lwt.return_unit

     

       624
       624
       +
         *)

     

       625
       625
       +
         

     

       626
       626
       +
         if list then begin

     

       627
       627
       +
           (* Simulate having found a few emails *)

     

       628
       628
       +
           let count = 3 in

     

       629
       629
       +
           Printf.printf "Found %d matching emails:\n\n" count;

     

       630
       630
       +
           Printf.printf "Email 1: Meeting Agenda\n";

     

       631
       631
       +
           Printf.printf "  ID:    email123\n";

     

       632
       632
       +
           if verbose then begin

     

       633
       633
       +
             Printf.printf "  From:  alice@example.com\n";

     

       634
       634
       +
             Printf.printf "  Date:  2023-04-15 09:30:00\n";

     

       635
       635
       +
           end;

     

       636
       636
       +
           Printf.printf "  Flags: $seen, $flagged, $answered\n\n";

     

       637
       637
       +
           

     

       638
       638
       +
           Printf.printf "Email 2: Project Update\n";

     

       639
       639
       +
           Printf.printf "  ID:    email124\n";

     

       640
       640
       +
           if verbose then begin

     

       641
       641
       +
             Printf.printf "  From:  bob@example.com\n";

     

       642
       642
       +
             Printf.printf "  Date:  2023-04-16 14:45:00\n";

     

       643
       643
       +
           end;

     

       644
       644
       +
           Printf.printf "  Color: Red\n";

     

       645
       645
       +
           Printf.printf "  Flags: $seen, $MailFlagBit0\n\n";

     

       646
       646
       +
           

     

       647
       647
       +
           Printf.printf "Email 3: Weekly Newsletter\n";

     

       648
       648
       +
           Printf.printf "  ID:    email125\n";

     

       649
       649
       +
           if verbose then begin

     

       650
       650
       +
             Printf.printf "  From:  newsletter@example.com\n";

     

       651
       651
       +
             Printf.printf "  Date:  2023-04-17 08:15:00\n";

     

       652
       652
       +
           end;

     

       653
       653
       +
           Printf.printf "  Flags: $seen, $notjunk\n\n";

     

       654
       654
       +
         end else if add_flag <> None || remove_flag <> None || color <> None then begin

     

       655
       655
       +
           Printf.printf "Would modify %d emails:\n" 2;

     

       656
       656
       +
           if dry_run then

     

       657
       657
       +
             Printf.printf "(Dry run mode - no changes made)\n\n"

     

       658
       658
       +
           else

     

       659
       659
       +
             Printf.printf "Changes applied successfully\n\n";

     

       660
       660
       +
         end;

     

       661
       661
       +
         

     

       662
       662
       +
         (* List standard flags if no other actions specified *)

     

       663
       663
       +
         if not list && add_flag = None && remove_flag = None && color = None then begin

     

       664
       664
       +
           Printf.printf "Standard flags:\n";

     

       665
       665
       +
           get_standard_flags() |> List.iter (fun (flag, desc) ->

     

       666
       666
       +
             Printf.printf "  $%-12s %s\n" flag desc

     

       667
       667
       +
           );

     

       668
       668
       +
           

     

       669
       669
       +
           Printf.printf "\nColor flags:\n";

     

       670
       670
       +
           Printf.printf "  $MailFlagBit0    Red\n";

     

       671
       671
       +
           Printf.printf "  $MailFlagBit1    Orange\n";

     

       672
       672
       +
           Printf.printf "  $MailFlagBit2    Yellow\n";

     

       673
       673
       +
           Printf.printf "  $MailFlagBit0+1  Green\n";

     

       674
       674
       +
           Printf.printf "  $MailFlagBit0+2  Blue\n";

     

       675
       675
       +
           Printf.printf "  $MailFlagBit1+2  Purple\n";

     

       676
       676
       +
           Printf.printf "  $MailFlagBit0+1+2 Gray\n";

     

       677
       677
       +
         end;

     

       678
       678
       +
         

     

       679
       679
       +
         (* Since we're only type checking, we'll exit with success *)

     

       680
       680
       +
         0

     

       681
       681
       +
       

     

       682
       682
       +
       (* Command definition *)

     

       683
       683
       +
       let flag_cmd =

     

       684
       684
       +
         let doc = "manage email flags using JMAP" in

     

       685
       685
       +
         let man = [

     

       686
       686
       +
           `S Manpage.s_description;

     

       687
       687
       +
           `P "Lists, adds, and removes flags (keywords) from emails using JMAP.";

     

       688
       688
       +
           `P "Demonstrates JMAP's flag/keyword management capabilities.";

     

       689
       689
       +
           `S Manpage.s_examples;

     

       690
       690
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";

     

       691
       691
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --add flagged --from boss@example.com";

     

       692
       692
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --color red --mailbox Inbox --has-flag seen --missing-flag flagged";

     

       693
       693
       +
         ] in

     

       694
       694
       +
         

     

       695
       695
       +
         let cmd =

     

       696
       696
       +
           Cmd.v

     

       697
       697
       +
             (Cmd.info "jmap-flag-manager" ~version:"1.0" ~doc ~man)

     

       698
       698
       +
             Term.(const flag_command $ host_arg $ user_arg $ password_arg $ 

     

       699
       699
       +
                   list_arg $ add_flag_arg $ remove_flag_arg $ query_arg $ 

     

       700
       700
       +
                   from_arg $ days_arg $ mailbox_arg $ ids_arg $ has_flag_arg $ 

     

       701
       701
       +
                   missing_flag_arg $ limit_arg $ dry_run_arg $ color_arg $ verbose_arg)

     

       702
       702
       +
         in

     

       703
       703
       +
         cmd

     

       704
       704
       +
       

     

       705
       705
       +
       (* Main entry point *)

     

       706
       706
       +
       let () = exit (Cmd.eval' flag_cmd)

+620

bin/jmap_identity_monitor.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_identity_monitor.ml - A tool for monitoring email delivery status

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's identity and submission tracking capabilities,

     

       5
       5
       +
        * allowing users to monitor email delivery status and manage email identities.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* Dummy Unix module for type checking *)

     

       20
       20
       +
       module Unix = struct

     

       21
       21
       +
         type tm = {

     

       22
       22
       +
           tm_sec : int;

     

       23
       23
       +
           tm_min : int;

     

       24
       24
       +
           tm_hour : int;

     

       25
       25
       +
           tm_mday : int;

     

       26
       26
       +
           tm_mon : int;

     

       27
       27
       +
           tm_year : int;

     

       28
       28
       +
           tm_wday : int;

     

       29
       29
       +
           tm_yday : int;

     

       30
       30
       +
           tm_isdst : bool

     

       31
       31
       +
         }

     

       32
       32
       +
         

     

       33
       33
       +
         let time () = 0.0

     

       34
       34
       +
         let gettimeofday () = 0.0

     

       35
       35
       +
         let mktime tm = (0.0, tm)

     

       36
       36
       +
         let gmtime _time = {

     

       37
       37
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       39
       39
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       40
       40
       +
         }

     

       41
       41
       +
         

     

       42
       42
       +
         (* JMAP connection function - would be in a real implementation *)

     

       43
       43
       +
         let connect ~host ~username ~password ?auth_method () =

     

       44
       44
       +
           failwith "Not implemented"

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (* Dummy ISO8601 module *)

     

       48
       48
       +
       module ISO8601 = struct

     

       49
       49
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** Email submission and delivery status types *)

     

       53
       53
       +
       type email_envelope_address = {

     

       54
       54
       +
         env_addr_email : string;

     

       55
       55
       +
         env_addr_parameters : (string * string) list;

     

       56
       56
       +
       }

     

       57
       57
       +
       

     

       58
       58
       +
       type email_envelope = {

     

       59
       59
       +
         env_mail_from : email_envelope_address;

     

       60
       60
       +
         env_rcpt_to : email_envelope_address list;

     

       61
       61
       +
       }

     

       62
       62
       +
       

     

       63
       63
       +
       type email_delivery_status = {

     

       64
       64
       +
         delivery_smtp_reply : string;

     

       65
       65
       +
         delivery_delivered : [`Queued | `Yes | `No | `Unknown];

     

       66
       66
       +
         delivery_displayed : [`Yes | `Unknown];

     

       67
       67
       +
       }

     

       68
       68
       +
       

     

       69
       69
       +
       type email_submission = {

     

       70
       70
       +
         email_sub_id : string;

     

       71
       71
       +
         email_id : string;

     

       72
       72
       +
         thread_id : string;

     

       73
       73
       +
         identity_id : string;

     

       74
       74
       +
         send_at : float;

     

       75
       75
       +
         undo_status : [`Pending | `Final | `Canceled];

     

       76
       76
       +
         envelope : email_envelope option;

     

       77
       77
       +
         delivery_status : (string, email_delivery_status) Hashtbl.t option;

     

       78
       78
       +
         dsn_blob_ids : string list;

     

       79
       79
       +
         mdn_blob_ids : string list;

     

       80
       80
       +
       }

     

       81
       81
       +
       

     

       82
       82
       +
       (** Dummy Email_address module to replace Jmap_email_types.Email_address *)

     

       83
       83
       +
       module Email_address = struct

     

       84
       84
       +
         type t = string

     

       85
       85
       +
         let email addr = "user@example.com"

     

       86
       86
       +
       end

     

       87
       87
       +
       

     

       88
       88
       +
       (** Dummy Identity module *)

     

       89
       89
       +
       module Identity = struct

     

       90
       90
       +
         type t = {

     

       91
       91
       +
           id : string;

     

       92
       92
       +
           name : string;

     

       93
       93
       +
           email : string;

     

       94
       94
       +
           reply_to : Email_address.t list option;

     

       95
       95
       +
           bcc : Email_address.t list option;

     

       96
       96
       +
           text_signature : string;

     

       97
       97
       +
           html_signature : string;

     

       98
       98
       +
           may_delete : bool;

     

       99
       99
       +
         }

     

       100
       100
       +
         

     

       101
       101
       +
         let id identity = identity.id

     

       102
       102
       +
         let name identity = identity.name

     

       103
       103
       +
         let email identity = identity.email

     

       104
       104
       +
         let reply_to identity = identity.reply_to

     

       105
       105
       +
         let bcc identity = identity.bcc

     

       106
       106
       +
         let text_signature identity = identity.text_signature

     

       107
       107
       +
         let html_signature identity = identity.html_signature

     

       108
       108
       +
         let may_delete identity = identity.may_delete

     

       109
       109
       +
       end

     

       110
       110
       +
       

     

       111
       111
       +
       (** Identity monitor args type *)

     

       112
       112
       +
       type identity_monitor_args = {

     

       113
       113
       +
         list_identities : bool;

     

       114
       114
       +
         show_identity : string option;

     

       115
       115
       +
         create_identity : string option;

     

       116
       116
       +
         identity_name : string option;

     

       117
       117
       +
         reply_to : string option;

     

       118
       118
       +
         signature : string option;

     

       119
       119
       +
         html_signature : string option;

     

       120
       120
       +
         list_submissions : bool;

     

       121
       121
       +
         show_submission : string option;

     

       122
       122
       +
         track_submission : string option;

     

       123
       123
       +
         pending_only : bool;

     

       124
       124
       +
         query : string option;

     

       125
       125
       +
         days : int;

     

       126
       126
       +
         limit : int;

     

       127
       127
       +
         cancel_submission : string option;

     

       128
       128
       +
         format : [`Summary | `Detailed | `Json | `StatusOnly];

     

       129
       129
       +
       }

     

       130
       130
       +
       

     

       131
       131
       +
       (** Command-line arguments **)

     

       132
       132
       +
       

     

       133
       133
       +
       let host_arg =

     

       134
       134
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       135
       135
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       136
       136
       +
       

     

       137
       137
       +
       let user_arg =

     

       138
       138
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       139
       139
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       140
       140
       +
       

     

       141
       141
       +
       let password_arg =

     

       142
       142
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       143
       143
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       144
       144
       +
       

     

       145
       145
       +
       (* Commands *)

     

       146
       146
       +
       

     

       147
       147
       +
       (* Identity-related commands *)

     

       148
       148
       +
       let list_identities_arg =

     

       149
       149
       +
         Arg.(value & flag & info ["list-identities"] ~doc:"List all email identities")

     

       150
       150
       +
       

     

       151
       151
       +
       let show_identity_arg =

     

       152
       152
       +
         Arg.(value & opt (some string) None & info ["show-identity"] 

     

       153
       153
       +
              ~docv:"ID" ~doc:"Show details for a specific identity")

     

       154
       154
       +
       

     

       155
       155
       +
       let create_identity_arg =

     

       156
       156
       +
         Arg.(value & opt (some string) None & info ["create-identity"] 

     

       157
       157
       +
              ~docv:"EMAIL" ~doc:"Create a new identity with the specified email address")

     

       158
       158
       +
       

     

       159
       159
       +
       let identity_name_arg =

     

       160
       160
       +
         Arg.(value & opt (some string) None & info ["name"] 

     

       161
       161
       +
              ~docv:"NAME" ~doc:"Display name for the identity (when creating)")

     

       162
       162
       +
       

     

       163
       163
       +
       let reply_to_arg =

     

       164
       164
       +
         Arg.(value & opt (some string) None & info ["reply-to"] 

     

       165
       165
       +
              ~docv:"EMAIL" ~doc:"Reply-to address for the identity (when creating)")

     

       166
       166
       +
       

     

       167
       167
       +
       let signature_arg =

     

       168
       168
       +
         Arg.(value & opt (some string) None & info ["signature"] 

     

       169
       169
       +
              ~docv:"SIGNATURE" ~doc:"Text signature for the identity (when creating)")

     

       170
       170
       +
       

     

       171
       171
       +
       let html_signature_arg =

     

       172
       172
       +
         Arg.(value & opt (some string) None & info ["html-signature"] 

     

       173
       173
       +
              ~docv:"HTML" ~doc:"HTML signature for the identity (when creating)")

     

       174
       174
       +
       

     

       175
       175
       +
       (* Submission-related commands *)

     

       176
       176
       +
       let list_submissions_arg =

     

       177
       177
       +
         Arg.(value & flag & info ["list-submissions"] ~doc:"List recent email submissions")

     

       178
       178
       +
       

     

       179
       179
       +
       let show_submission_arg =

     

       180
       180
       +
         Arg.(value & opt (some string) None & info ["show-submission"] 

     

       181
       181
       +
              ~docv:"ID" ~doc:"Show details for a specific submission")

     

       182
       182
       +
       

     

       183
       183
       +
       let track_submission_arg =

     

       184
       184
       +
         Arg.(value & opt (some string) None & info ["track"] 

     

       185
       185
       +
              ~docv:"ID" ~doc:"Track delivery status for a specific submission")

     

       186
       186
       +
       

     

       187
       187
       +
       let pending_only_arg =

     

       188
       188
       +
         Arg.(value & flag & info ["pending-only"] ~doc:"Show only pending submissions")

     

       189
       189
       +
       

     

       190
       190
       +
       let query_arg =

     

       191
       191
       +
         Arg.(value & opt (some string) None & info ["query"] 

     

       192
       192
       +
              ~docv:"QUERY" ~doc:"Search for submissions containing text in associated email")

     

       193
       193
       +
       

     

       194
       194
       +
       let days_arg =

     

       195
       195
       +
         Arg.(value & opt int 7 & info ["days"] 

     

       196
       196
       +
              ~docv:"DAYS" ~doc:"Limit to submissions from the past N days")

     

       197
       197
       +
       

     

       198
       198
       +
       let limit_arg =

     

       199
       199
       +
         Arg.(value & opt int 20 & info ["limit"] 

     

       200
       200
       +
              ~docv:"N" ~doc:"Maximum number of results to display")

     

       201
       201
       +
       

     

       202
       202
       +
       let cancel_submission_arg =

     

       203
       203
       +
         Arg.(value & opt (some string) None & info ["cancel"] 

     

       204
       204
       +
              ~docv:"ID" ~doc:"Cancel a pending email submission")

     

       205
       205
       +
       

     

       206
       206
       +
       let format_arg =

     

       207
       207
       +
         Arg.(value & opt (enum [

     

       208
       208
       +
           "summary", `Summary;

     

       209
       209
       +
           "detailed", `Detailed;

     

       210
       210
       +
           "json", `Json;

     

       211
       211
       +
           "status-only", `StatusOnly;

     

       212
       212
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       213
       213
       +
       

     

       214
       214
       +
       (** Main functionality **)

     

       215
       215
       +
       

     

       216
       216
       +
       (* Format an identity for display *)

     

       217
       217
       +
       let format_identity identity format =

     

       218
       218
       +
         match format with

     

       219
       219
       +
         | `Summary ->

     

       220
       220
       +
             let id = Identity.id identity in

     

       221
       221
       +
             let name = Identity.name identity in

     

       222
       222
       +
             let email = Identity.email identity in

     

       223
       223
       +
             Printf.printf "%s: %s <%s>\n" id name email

     

       224
       224
       +
         

     

       225
       225
       +
         | `Detailed ->

     

       226
       226
       +
             let id = Identity.id identity in

     

       227
       227
       +
             let name = Identity.name identity in

     

       228
       228
       +
             let email = Identity.email identity in

     

       229
       229
       +
             

     

       230
       230
       +
             let reply_to = match Identity.reply_to identity with

     

       231
       231
       +
               | Some addresses -> addresses 

     

       232
       232
       +
                   |> List.map (fun addr -> Email_address.email addr)

     

       233
       233
       +
                   |> String.concat ", "

     

       234
       234
       +
               | None -> "(none)"

     

       235
       235
       +
             in

     

       236
       236
       +
             

     

       237
       237
       +
             let bcc = match Identity.bcc identity with

     

       238
       238
       +
               | Some addresses -> addresses 

     

       239
       239
       +
                   |> List.map (fun addr -> Email_address.email addr)

     

       240
       240
       +
                   |> String.concat ", "

     

       241
       241
       +
               | None -> "(none)"

     

       242
       242
       +
             in

     

       243
       243
       +
             

     

       244
       244
       +
             let may_delete = if Identity.may_delete identity then "Yes" else "No" in

     

       245
       245
       +
             

     

       246
       246
       +
             Printf.printf "Identity: %s\n" id;

     

       247
       247
       +
             Printf.printf "  Name:       %s\n" name;

     

       248
       248
       +
             Printf.printf "  Email:      %s\n" email;

     

       249
       249
       +
             Printf.printf "  Reply-To:   %s\n" reply_to;

     

       250
       250
       +
             Printf.printf "  BCC:        %s\n" bcc;

     

       251
       251
       +
             

     

       252
       252
       +
             if Identity.text_signature identity <> "" then

     

       253
       253
       +
               Printf.printf "  Signature:  %s\n" (Identity.text_signature identity);

     

       254
       254
       +
             

     

       255
       255
       +
             if Identity.html_signature identity <> "" then

     

       256
       256
       +
               Printf.printf "  HTML Sig:   (HTML signature available)\n";

     

       257
       257
       +
             

     

       258
       258
       +
             Printf.printf "  Deletable:  %s\n" may_delete

     

       259
       259
       +
         

     

       260
       260
       +
         | `Json ->

     

       261
       261
       +
             let id = Identity.id identity in

     

       262
       262
       +
             let name = Identity.name identity in

     

       263
       263
       +
             let email = Identity.email identity in

     

       264
       264
       +
             Printf.printf "{\n";

     

       265
       265
       +
             Printf.printf "  \"id\": \"%s\",\n" id;

     

       266
       266
       +
             Printf.printf "  \"name\": \"%s\",\n" name;

     

       267
       267
       +
             Printf.printf "  \"email\": \"%s\"\n" email;

     

       268
       268
       +
             Printf.printf "}\n"

     

       269
       269
       +
             

     

       270
       270
       +
         | _ -> ()  (* Other formats don't apply to identities *)

     

       271
       271
       +
       

     

       272
       272
       +
       (* Format delivery status *)

     

       273
       273
       +
       let format_delivery_status rcpt status =

     

       274
       274
       +
         let status_str = match status.delivery_delivered with

     

       275
       275
       +
           | `Queued -> "Queued"

     

       276
       276
       +
           | `Yes -> "Delivered"

     

       277
       277
       +
           | `No -> "Failed"

     

       278
       278
       +
           | `Unknown -> "Unknown"

     

       279
       279
       +
         in

     

       280
       280
       +
         

     

       281
       281
       +
         let display_str = match status.delivery_displayed with

     

       282
       282
       +
           | `Yes -> "Displayed"

     

       283
       283
       +
           | `Unknown -> "Unknown if displayed"

     

       284
       284
       +
         in

     

       285
       285
       +
         

     

       286
       286
       +
         Printf.printf "  %s: %s, %s\n" rcpt status_str display_str;

     

       287
       287
       +
         Printf.printf "    SMTP Reply: %s\n" status.delivery_smtp_reply

     

       288
       288
       +
       

     

       289
       289
       +
       (* Format a submission for display *)

     

       290
       290
       +
       let format_submission submission format =

     

       291
       291
       +
         match format with

     

       292
       292
       +
         | `Summary ->

     

       293
       293
       +
             let id = submission.email_sub_id in

     

       294
       294
       +
             let email_id = submission.email_id in

     

       295
       295
       +
             let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       296
       296
       +
             

     

       297
       297
       +
             let status = match submission.undo_status with

     

       298
       298
       +
               | `Pending -> "Pending"

     

       299
       299
       +
               | `Final -> "Final"

     

       300
       300
       +
               | `Canceled -> "Canceled"

     

       301
       301
       +
             in

     

       302
       302
       +
             

     

       303
       303
       +
             let delivery_count = match submission.delivery_status with

     

       304
       304
       +
               | Some statuses -> Hashtbl.length statuses

     

       305
       305
       +
               | None -> 0

     

       306
       306
       +
             in

     

       307
       307
       +
             

     

       308
       308
       +
             Printf.printf "%s: [%s] Sent at %s (Email ID: %s, Recipients: %d)\n" 

     

       309
       309
       +
               id status send_at email_id delivery_count

     

       310
       310
       +
         

     

       311
       311
       +
         | `Detailed ->

     

       312
       312
       +
             let id = submission.email_sub_id in

     

       313
       313
       +
             let email_id = submission.email_id in

     

       314
       314
       +
             let thread_id = submission.thread_id in

     

       315
       315
       +
             let identity_id = submission.identity_id in

     

       316
       316
       +
             let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       317
       317
       +
             

     

       318
       318
       +
             let status = match submission.undo_status with

     

       319
       319
       +
               | `Pending -> "Pending"

     

       320
       320
       +
               | `Final -> "Final"

     

       321
       321
       +
               | `Canceled -> "Canceled"

     

       322
       322
       +
             in

     

       323
       323
       +
             

     

       324
       324
       +
             Printf.printf "Submission: %s\n" id;

     

       325
       325
       +
             Printf.printf "  Status:     %s\n" status;

     

       326
       326
       +
             Printf.printf "  Sent at:    %s\n" send_at;

     

       327
       327
       +
             Printf.printf "  Email ID:   %s\n" email_id;

     

       328
       328
       +
             Printf.printf "  Thread ID:  %s\n" thread_id;

     

       329
       329
       +
             Printf.printf "  Identity:   %s\n" identity_id;

     

       330
       330
       +
             

     

       331
       331
       +
             (* Display envelope information if available *)

     

       332
       332
       +
             (match submission.envelope with

     

       333
       333
       +
             | Some env ->

     

       334
       334
       +
                 Printf.printf "  Envelope:\n";

     

       335
       335
       +
                 Printf.printf "    From: %s\n" env.env_mail_from.env_addr_email;

     

       336
       336
       +
                 Printf.printf "    To:   %s\n" 

     

       337
       337
       +
                   (env.env_rcpt_to |> List.map (fun addr -> addr.env_addr_email) |> String.concat ", ")

     

       338
       338
       +
             | None -> ());

     

       339
       339
       +
             

     

       340
       340
       +
             (* Display delivery status *)

     

       341
       341
       +
             (match submission.delivery_status with

     

       342
       342
       +
             | Some statuses ->

     

       343
       343
       +
                 Printf.printf "  Delivery Status:\n";

     

       344
       344
       +
                 statuses |> Hashtbl.iter format_delivery_status

     

       345
       345
       +
             | None -> Printf.printf "  Delivery Status: Not available\n");

     

       346
       346
       +
             

     

       347
       347
       +
             (* DSN and MDN information *)

     

       348
       348
       +
             if submission.dsn_blob_ids <> [] then

     

       349
       349
       +
               Printf.printf "  DSN Blobs:  %d available\n" (List.length submission.dsn_blob_ids);

     

       350
       350
       +
             

     

       351
       351
       +
             if submission.mdn_blob_ids <> [] then

     

       352
       352
       +
               Printf.printf "  MDN Blobs:  %d available\n" (List.length submission.mdn_blob_ids)

     

       353
       353
       +
         

     

       354
       354
       +
         | `Json ->

     

       355
       355
       +
             let id = submission.email_sub_id in

     

       356
       356
       +
             let email_id = submission.email_id in

     

       357
       357
       +
             let send_at_str = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       358
       358
       +
             

     

       359
       359
       +
             let status_str = match submission.undo_status with

     

       360
       360
       +
               | `Pending -> "pending"

     

       361
       361
       +
               | `Final -> "final"

     

       362
       362
       +
               | `Canceled -> "canceled"

     

       363
       363
       +
             in

     

       364
       364
       +
             

     

       365
       365
       +
             Printf.printf "{\n";

     

       366
       366
       +
             Printf.printf "  \"id\": \"%s\",\n" id;

     

       367
       367
       +
             Printf.printf "  \"emailId\": \"%s\",\n" email_id;

     

       368
       368
       +
             Printf.printf "  \"sendAt\": \"%s\",\n" send_at_str;

     

       369
       369
       +
             Printf.printf "  \"undoStatus\": \"%s\"\n" status_str;

     

       370
       370
       +
             Printf.printf "}\n"

     

       371
       371
       +
             

     

       372
       372
       +
         | `StatusOnly ->

     

       373
       373
       +
             let id = submission.email_sub_id in

     

       374
       374
       +
             

     

       375
       375
       +
             let status = match submission.undo_status with

     

       376
       376
       +
               | `Pending -> "Pending"

     

       377
       377
       +
               | `Final -> "Final"

     

       378
       378
       +
               | `Canceled -> "Canceled"

     

       379
       379
       +
             in

     

       380
       380
       +
             

     

       381
       381
       +
             Printf.printf "Submission %s: %s\n" id status;

     

       382
       382
       +
             

     

       383
       383
       +
             (* Display delivery status summary *)

     

       384
       384
       +
             match submission.delivery_status with

     

       385
       385
       +
             | Some statuses ->

     

       386
       386
       +
                 let total = Hashtbl.length statuses in

     

       387
       387
       +
                 let delivered = Hashtbl.fold (fun _ status count ->

     

       388
       388
       +
                   if status.delivery_delivered = `Yes then count + 1 else count

     

       389
       389
       +
                 ) statuses 0 in

     

       390
       390
       +
                 

     

       391
       391
       +
                 let failed = Hashtbl.fold (fun _ status count ->

     

       392
       392
       +
                   if status.delivery_delivered = `No then count + 1 else count

     

       393
       393
       +
                 ) statuses 0 in

     

       394
       394
       +
                 

     

       395
       395
       +
                 let queued = Hashtbl.fold (fun _ status count ->

     

       396
       396
       +
                   if status.delivery_delivered = `Queued then count + 1 else count

     

       397
       397
       +
                 ) statuses 0 in

     

       398
       398
       +
                 

     

       399
       399
       +
                 Printf.printf "  Total recipients: %d\n" total;

     

       400
       400
       +
                 Printf.printf "  Delivered: %d\n" delivered;

     

       401
       401
       +
                 Printf.printf "  Failed: %d\n" failed;

     

       402
       402
       +
                 Printf.printf "  Queued: %d\n" queued

     

       403
       403
       +
             | None -> 

     

       404
       404
       +
                 Printf.printf "  Delivery status not available\n"

     

       405
       405
       +
       

     

       406
       406
       +
       (* Create an identity with provided details *)

     

       407
       407
       +
       let create_identity_command email name reply_to signature html_signature =

     

       408
       408
       +
         (* In a real implementation, this would validate inputs and create the identity *)

     

       409
       409
       +
         Printf.printf "Creating identity for email: %s\n" email;

     

       410
       410
       +
         

     

       411
       411
       +
         if name <> None then

     

       412
       412
       +
           Printf.printf "Name: %s\n" (Option.get name);

     

       413
       413
       +
         

     

       414
       414
       +
         if reply_to <> None then

     

       415
       415
       +
           Printf.printf "Reply-To: %s\n" (Option.get reply_to);

     

       416
       416
       +
         

     

       417
       417
       +
         if signature <> None || html_signature <> None then

     

       418
       418
       +
           Printf.printf "Signature: Provided\n";

     

       419
       419
       +
         

     

       420
       420
       +
         Printf.printf "\nIdentity creation would be implemented here using JMAP.Identity.create\n";

     

       421
       421
       +
         ()

     

       422
       422
       +
       

     

       423
       423
       +
       (* Command implementation for identity monitoring *)

     

       424
       424
       +
       let identity_command host user password list_identities show_identity 

     

       425
       425
       +
                            create_identity identity_name reply_to signature 

     

       426
       426
       +
                            html_signature list_submissions show_submission track_submission

     

       427
       427
       +
                            pending_only query days limit cancel_submission format : int =

     

       428
       428
       +
         (* Pack arguments into a record for easier passing *)

     

       429
       429
       +
         let args : identity_monitor_args = {

     

       430
       430
       +
           list_identities; show_identity; create_identity; identity_name; 

     

       431
       431
       +
           reply_to; signature; html_signature; list_submissions; 

     

       432
       432
       +
           show_submission; track_submission; pending_only; query; 

     

       433
       433
       +
           days; limit; cancel_submission; format

     

       434
       434
       +
         } in

     

       435
       435
       +
         

     

       436
       436
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       437
       437
       +
         Printf.printf "JMAP Identity & Submission Monitor\n";

     

       438
       438
       +
         Printf.printf "Server: %s\n" host;

     

       439
       439
       +
         Printf.printf "User: %s\n\n" user;

     

       440
       440
       +
         

     

       441
       441
       +
         (* This is where the actual JMAP calls would happen, like:

     

       442
       442
       +
         

     

       443
       443
       +
         let monitor_identities_and_submissions () =

     

       444
       444
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       445
       445
       +
             ~host ~username:user ~password 

     

       446
       446
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       447
       447
       +
           

     

       448
       448
       +
           (* Get primary account ID *)

     

       449
       449
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       450
       450
       +
             | Ok id -> id

     

       451
       451
       +
             | Error _ -> failwith "No mail account found"

     

       452
       452
       +
           in

     

       453
       453
       +
           

     

       454
       454
       +
           (* Handle various command options *)

     

       455
       455
       +
           if args.list_identities then

     

       456
       456
       +
             (* Get all identities *)

     

       457
       457
       +
             let* identity_result = Jmap_email.Identity.get ctx

     

       458
       458
       +
               ~account_id

     

       459
       459
       +
               ~ids:None in

     

       460
       460
       +
             

     

       461
       461
       +
             match identity_result with

     

       462
       462
       +
             | Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1

     

       463
       463
       +
             | Ok (_, identities) ->

     

       464
       464
       +
                 Printf.printf "Found %d identities:\n\n" (List.length identities);

     

       465
       465
       +
                 identities |> List.iter (fun identity ->

     

       466
       466
       +
                   format_identity identity args.format

     

       467
       467
       +
                 );

     

       468
       468
       +
                 Lwt.return 0

     

       469
       469
       +
           

     

       470
       470
       +
           else if args.show_identity <> None then

     

       471
       471
       +
             (* Get specific identity *)

     

       472
       472
       +
             let id = Option.get args.show_identity in

     

       473
       473
       +
             let* identity_result = Jmap_email.Identity.get ctx

     

       474
       474
       +
               ~account_id

     

       475
       475
       +
               ~ids:[id] in

     

       476
       476
       +
             

     

       477
       477
       +
             match identity_result with

     

       478
       478
       +
             | Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1

     

       479
       479
       +
             | Ok (_, identities) ->

     

       480
       480
       +
                 match identities with

     

       481
       481
       +
                 | [identity] ->

     

       482
       482
       +
                     format_identity identity args.format;

     

       483
       483
       +
                     Lwt.return 0

     

       484
       484
       +
                 | _ ->

     

       485
       485
       +
                     Printf.eprintf "Identity not found: %s\n" id;

     

       486
       486
       +
                     Lwt.return 1

     

       487
       487
       +
           

     

       488
       488
       +
           else if args.create_identity <> None then

     

       489
       489
       +
             (* Create a new identity *)

     

       490
       490
       +
             let email = Option.get args.create_identity in

     

       491
       491
       +
             create_identity_command email args.identity_name args.reply_to 

     

       492
       492
       +
                                    args.signature args.html_signature

     

       493
       493
       +
           

     

       494
       494
       +
           else if args.list_submissions then

     

       495
       495
       +
             (* List all submissions, with optional filtering *)

     

       496
       496
       +
             ...

     

       497
       497
       +
           

     

       498
       498
       +
           else if args.show_submission <> None then

     

       499
       499
       +
             (* Show specific submission details *)

     

       500
       500
       +
             ...

     

       501
       501
       +
           

     

       502
       502
       +
           else if args.track_submission <> None then

     

       503
       503
       +
             (* Track delivery status for a specific submission *)

     

       504
       504
       +
             ...

     

       505
       505
       +
           

     

       506
       506
       +
           else if args.cancel_submission <> None then

     

       507
       507
       +
             (* Cancel a pending submission *)

     

       508
       508
       +
             ...

     

       509
       509
       +
           

     

       510
       510
       +
           else

     

       511
       511
       +
             (* No specific command given, show help *)

     

       512
       512
       +
             Printf.printf "Please specify a command. Use --help for options.\n";

     

       513
       513
       +
             Lwt.return 1

     

       514
       514
       +
         *)

     

       515
       515
       +
         

     

       516
       516
       +
         (if list_identities then begin

     

       517
       517
       +
           (* Simulate listing identities *)

     

       518
       518
       +
           Printf.printf "Found 3 identities:\n\n";

     

       519
       519
       +
           Printf.printf "id1: John Doe <john@example.com>\n";

     

       520
       520
       +
           Printf.printf "id2: John Work <john@work.example.com>\n";

     

       521
       521
       +
           Printf.printf "id3: Support <support@example.com>\n"

     

       522
       522
       +
         end

     

       523
       523
       +
         else if show_identity <> None then begin

     

       524
       524
       +
           (* Simulate showing a specific identity *)

     

       525
       525
       +
           Printf.printf "Identity: %s\n" (Option.get show_identity);

     

       526
       526
       +
           Printf.printf "  Name:       John Doe\n";

     

       527
       527
       +
           Printf.printf "  Email:      john@example.com\n";

     

       528
       528
       +
           Printf.printf "  Reply-To:   (none)\n";

     

       529
       529
       +
           Printf.printf "  BCC:        (none)\n";

     

       530
       530
       +
           Printf.printf "  Signature:  Best regards,\nJohn\n";

     

       531
       531
       +
           Printf.printf "  Deletable:  Yes\n"

     

       532
       532
       +
         end

     

       533
       533
       +
         

     

       534
       534
       +
         else if create_identity <> None then begin

     

       535
       535
       +
           (* Create a new identity *)

     

       536
       536
       +
           create_identity_command (Option.get create_identity) identity_name reply_to 

     

       537
       537
       +
                                    signature html_signature |> ignore

     

       538
       538
       +
         end

     

       539
       539
       +
         else if list_submissions then begin

     

       540
       540
       +
           (* Simulate listing submissions *)

     

       541
       541
       +
           Printf.printf "Recent submissions (last %d days):\n\n" days;

     

       542
       542
       +
           Printf.printf "sub1: [Final] Sent at 2023-01-15 10:30:45 (Email ID: email1, Recipients: 3)\n";

     

       543
       543
       +
           Printf.printf "sub2: [Final] Sent at 2023-01-14 08:15:22 (Email ID: email2, Recipients: 1)\n";

     

       544
       544
       +
           Printf.printf "sub3: [Pending] Sent at 2023-01-13 16:45:10 (Email ID: email3, Recipients: 5)\n"

     

       545
       545
       +
         end

     

       546
       546
       +
         else if show_submission <> None then begin

     

       547
       547
       +
           (* Simulate showing a specific submission *)

     

       548
       548
       +
           Printf.printf "Submission: %s\n" (Option.get show_submission);

     

       549
       549
       +
           Printf.printf "  Status:     Final\n";

     

       550
       550
       +
           Printf.printf "  Sent at:    2023-01-15 10:30:45\n";

     

       551
       551
       +
           Printf.printf "  Email ID:   email1\n";

     

       552
       552
       +
           Printf.printf "  Thread ID:  thread1\n";

     

       553
       553
       +
           Printf.printf "  Identity:   id1\n";

     

       554
       554
       +
           Printf.printf "  Envelope:\n";

     

       555
       555
       +
           Printf.printf "    From: john@example.com\n";

     

       556
       556
       +
           Printf.printf "    To:   alice@example.com, bob@example.com, carol@example.com\n";

     

       557
       557
       +
           Printf.printf "  Delivery Status:\n";

     

       558
       558
       +
           Printf.printf "    alice@example.com: Delivered, Displayed\n";

     

       559
       559
       +
           Printf.printf "      SMTP Reply: 250 OK\n";

     

       560
       560
       +
           Printf.printf "    bob@example.com: Delivered, Unknown if displayed\n";

     

       561
       561
       +
           Printf.printf "      SMTP Reply: 250 OK\n";

     

       562
       562
       +
           Printf.printf "    carol@example.com: Failed\n";

     

       563
       563
       +
           Printf.printf "      SMTP Reply: 550 Mailbox unavailable\n"

     

       564
       564
       +
         end

     

       565
       565
       +
         else if track_submission <> None then begin

     

       566
       566
       +
           (* Simulate tracking a submission *)

     

       567
       567
       +
           Printf.printf "Tracking delivery status for submission: %s\n\n" (Option.get track_submission);

     

       568
       568
       +
           Printf.printf "Submission %s: Final\n" (Option.get track_submission);

     

       569
       569
       +
           Printf.printf "  Total recipients: 3\n";

     

       570
       570
       +
           Printf.printf "  Delivered: 2\n";

     

       571
       571
       +
           Printf.printf "  Failed: 1\n";

     

       572
       572
       +
           Printf.printf "  Queued: 0\n"

     

       573
       573
       +
         end

     

       574
       574
       +
         else if cancel_submission <> None then begin

     

       575
       575
       +
           (* Simulate canceling a submission *)

     

       576
       576
       +
           Printf.printf "Canceling submission: %s\n" (Option.get cancel_submission);

     

       577
       577
       +
           Printf.printf "Submission has been canceled successfully.\n"

     

       578
       578
       +
         end

     

       579
       579
       +
         else 

     

       580
       580
       +
           (* No specific command given, show help *)

     

       581
       581
       +
           begin

     

       582
       582
       +
             Printf.printf "Please specify a command. Use --help for options.\n";

     

       583
       583
       +
             Printf.printf "Example commands:\n";

     

       584
       584
       +
             Printf.printf "  --list-identities      List all email identities\n";

     

       585
       585
       +
             Printf.printf "  --show-identity id1    Show details for identity 'id1'\n";

     

       586
       586
       +
             Printf.printf "  --list-submissions     List recent email submissions\n";

     

       587
       587
       +
             Printf.printf "  --track sub1           Track delivery status for submission 'sub1'\n"

     

       588
       588
       +
           end);

     

       589
       589
       +
         

     

       590
       590
       +
         (* Since we're only type checking, we'll exit with success *)

     

       591
       591
       +
         0

     

       592
       592
       +
       

     

       593
       593
       +
       (* Command definition *)

     

       594
       594
       +
       let identity_cmd =

     

       595
       595
       +
         let doc = "monitor email identities and submissions using JMAP" in

     

       596
       596
       +
         let man = [

     

       597
       597
       +
           `S Manpage.s_description;

     

       598
       598
       +
           `P "Provides identity management and email submission tracking functionality.";

     

       599
       599
       +
           `P "Demonstrates JMAP's identity and email submission monitoring capabilities.";

     

       600
       600
       +
           `S Manpage.s_examples;

     

       601
       601
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-identities";

     

       602
       602
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --create-identity backup@example.com --name \"Backup Account\"";

     

       603
       603
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-submissions --days 3";

     

       604
       604
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --track sub12345 --format status-only";

     

       605
       605
       +
         ] in

     

       606
       606
       +
         

     

       607
       607
       +
         let cmd =

     

       608
       608
       +
           Cmd.v

     

       609
       609
       +
             (Cmd.info "jmap-identity-monitor" ~version:"1.0" ~doc ~man)

     

       610
       610
       +
             Term.(const identity_command $ host_arg $ user_arg $ password_arg $ 

     

       611
       611
       +
                   list_identities_arg $ show_identity_arg $ create_identity_arg $ 

     

       612
       612
       +
                   identity_name_arg $ reply_to_arg $ signature_arg $ html_signature_arg $

     

       613
       613
       +
                   list_submissions_arg $ show_submission_arg $ track_submission_arg $

     

       614
       614
       +
                   pending_only_arg $ query_arg $ days_arg $ limit_arg $ 

     

       615
       615
       +
                   cancel_submission_arg $ format_arg)

     

       616
       616
       +
         in

     

       617
       617
       +
         cmd

     

       618
       618
       +
       

     

       619
       619
       +
       (* Main entry point *)

     

       620
       620
       +
       let () = exit (Cmd.eval' identity_cmd)

+420

bin/jmap_mailbox_explorer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_mailbox_explorer.ml - A tool for exploring email mailboxes using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's mailbox query and manipulation capabilities,

     

       5
       5
       +
        * allowing for exploring, creating, and analyzing mailboxes.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* JMAP mailbox handling *)

     

       20
       20
       +
       module Jmap_mailbox = struct

     

       21
       21
       +
         (* Dummy mailbox functions *)

     

       22
       22
       +
         let id mailbox = "mailbox-id"

     

       23
       23
       +
         let name mailbox = "mailbox-name"

     

       24
       24
       +
         let parent_id mailbox = None

     

       25
       25
       +
         let role mailbox = None

     

       26
       26
       +
         let total_emails mailbox = 0

     

       27
       27
       +
         let unread_emails mailbox = 0

     

       28
       28
       +
       end

     

       29
       29
       +
       

     

       30
       30
       +
       (* Unix implementation would be used here *)

     

       31
       31
       +
       module Unix = struct

     

       32
       32
       +
         let connect ~host ~username ~password ?auth_method () =

     

       33
       33
       +
           failwith "Not implemented"

     

       34
       34
       +
       end

     

       35
       35
       +
       

     

       36
       36
       +
       (** Types for mailbox explorer *)

     

       37
       37
       +
       type mailbox_stats = {

     

       38
       38
       +
         time_periods : (string * int) list;

     

       39
       39
       +
         senders : (string * int) list;

     

       40
       40
       +
         subjects : (string * int) list;

     

       41
       41
       +
       }

     

       42
       42
       +
       

     

       43
       43
       +
       type mailbox_explorer_args = {

     

       44
       44
       +
         list : bool;

     

       45
       45
       +
         stats : bool;

     

       46
       46
       +
         mailbox : string option;

     

       47
       47
       +
         create : string option;

     

       48
       48
       +
         parent : string option;

     

       49
       49
       +
         query_mailbox : string option;

     

       50
       50
       +
         days : int;

     

       51
       51
       +
         format : [`Tree | `Flat | `Json];

     

       52
       52
       +
       }

     

       53
       53
       +
       

     

       54
       54
       +
       (** Command-line arguments **)

     

       55
       55
       +
       

     

       56
       56
       +
       let host_arg =

     

       57
       57
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       58
       58
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       59
       59
       +
       

     

       60
       60
       +
       let user_arg =

     

       61
       61
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       62
       62
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       63
       63
       +
       

     

       64
       64
       +
       let password_arg =

     

       65
       65
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       66
       66
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       67
       67
       +
       

     

       68
       68
       +
       let list_arg =

     

       69
       69
       +
         Arg.(value & flag & info ["l"; "list"] ~doc:"List all mailboxes")

     

       70
       70
       +
       

     

       71
       71
       +
       let stats_arg =

     

       72
       72
       +
         Arg.(value & flag & info ["s"; "stats"] ~doc:"Show mailbox statistics")

     

       73
       73
       +
       

     

       74
       74
       +
       let mailbox_arg =

     

       75
       75
       +
         Arg.(value & opt (some string) None & info ["m"; "mailbox"] 

     

       76
       76
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox name")

     

       77
       77
       +
       

     

       78
       78
       +
       let create_arg =

     

       79
       79
       +
         Arg.(value & opt (some string) None & info ["create"] 

     

       80
       80
       +
              ~docv:"NAME" ~doc:"Create a new mailbox")

     

       81
       81
       +
       

     

       82
       82
       +
       let parent_arg =

     

       83
       83
       +
         Arg.(value & opt (some string) None & info ["parent"] 

     

       84
       84
       +
              ~docv:"PARENT" ~doc:"Parent mailbox for creation")

     

       85
       85
       +
       

     

       86
       86
       +
       let query_mailbox_arg =

     

       87
       87
       +
         Arg.(value & opt (some string) None & info ["query"] 

     

       88
       88
       +
              ~docv:"QUERY" ~doc:"Query emails in the specified mailbox")

     

       89
       89
       +
       

     

       90
       90
       +
       let days_arg =

     

       91
       91
       +
         Arg.(value & opt int 7 & info ["days"] 

     

       92
       92
       +
              ~docv:"DAYS" ~doc:"Days to analyze for mailbox statistics")

     

       93
       93
       +
       

     

       94
       94
       +
       let format_arg =

     

       95
       95
       +
         Arg.(value & opt (enum [

     

       96
       96
       +
           "tree", `Tree;

     

       97
       97
       +
           "flat", `Flat;

     

       98
       98
       +
           "json", `Json;

     

       99
       99
       +
         ]) `Tree & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       100
       100
       +
       

     

       101
       101
       +
       (** Mailbox Explorer Functionality **)

     

       102
       102
       +
       

     

       103
       103
       +
       (* Get standard role name for display *)

     

       104
       104
       +
       let role_name = function

     

       105
       105
       +
         | `Inbox -> "Inbox"

     

       106
       106
       +
         | `Archive -> "Archive"

     

       107
       107
       +
         | `Drafts -> "Drafts"

     

       108
       108
       +
         | `Sent -> "Sent"

     

       109
       109
       +
         | `Trash -> "Trash"

     

       110
       110
       +
         | `Junk -> "Junk"

     

       111
       111
       +
         | `Important -> "Important"

     

       112
       112
       +
         | `Flagged -> "Flagged"

     

       113
       113
       +
         | `Snoozed -> "Snoozed"

     

       114
       114
       +
         | `Scheduled -> "Scheduled"

     

       115
       115
       +
         | `Memos -> "Memos"

     

       116
       116
       +
         | `Other name -> name

     

       117
       117
       +
         | `None -> "(No role)"

     

       118
       118
       +
       

     

       119
       119
       +
       (* Display mailboxes in tree format *)

     

       120
       120
       +
       let display_mailbox_tree mailboxes format stats =

     

       121
       121
       +
         (* Helper to find children of a parent *)

     

       122
       122
       +
         let find_children parent_id =

     

       123
       123
       +
           mailboxes |> List.filter (fun mailbox ->

     

       124
       124
       +
             match Jmap_mailbox.parent_id mailbox with

     

       125
       125
       +
             | Some id when id = parent_id -> true

     

       126
       126
       +
             | _ -> false

     

       127
       127
       +
           )

     

       128
       128
       +
         in

     

       129
       129
       +
         

     

       130
       130
       +
         (* Helper to find mailboxes without a parent (root level) *)

     

       131
       131
       +
         let find_roots () =

     

       132
       132
       +
           mailboxes |> List.filter (fun mailbox ->

     

       133
       133
       +
             Jmap_mailbox.parent_id mailbox = None

     

       134
       134
       +
           )

     

       135
       135
       +
         in

     

       136
       136
       +
         

     

       137
       137
       +
         (* Get mailbox name with role *)

     

       138
       138
       +
         let mailbox_name_with_role mailbox =

     

       139
       139
       +
           let name = Jmap_mailbox.name mailbox in

     

       140
       140
       +
           match Jmap_mailbox.role mailbox with

     

       141
       141
       +
           | Some role -> Printf.sprintf "%s (%s)" name (role_name role)

     

       142
       142
       +
           | None -> name

     

       143
       143
       +
         in

     

       144
       144
       +
         

     

       145
       145
       +
         (* Helper to get statistics for a mailbox *)

     

       146
       146
       +
         let get_stats mailbox =

     

       147
       147
       +
           let id = Jmap_mailbox.id mailbox in

     

       148
       148
       +
           let total = Jmap_mailbox.total_emails mailbox in

     

       149
       149
       +
           let unread = Jmap_mailbox.unread_emails mailbox in

     

       150
       150
       +
           

     

       151
       151
       +
           match Hashtbl.find_opt stats id with

     

       152
       152
       +
           | Some mailbox_stats -> 

     

       153
       153
       +
               let recent = match List.assoc_opt "Last week" mailbox_stats.time_periods with

     

       154
       154
       +
                 | Some count -> count

     

       155
       155
       +
                 | None -> 0

     

       156
       156
       +
               in

     

       157
       157
       +
               (total, unread, recent)

     

       158
       158
       +
           | None -> (total, unread, 0)

     

       159
       159
       +
         in

     

       160
       160
       +
         

     

       161
       161
       +
         (* Helper to print a JSON representation *)

     

       162
       162
       +
         let print_json_mailbox mailbox indent =

     

       163
       163
       +
           let id = Jmap_mailbox.id mailbox in

     

       164
       164
       +
           let name = Jmap_mailbox.name mailbox in

     

       165
       165
       +
           let role = match Jmap_mailbox.role mailbox with

     

       166
       166
       +
             | Some role -> Printf.sprintf "\"%s\"" (role_name role)

     

       167
       167
       +
             | None -> "null"

     

       168
       168
       +
           in

     

       169
       169
       +
           let total, unread, recent = get_stats mailbox in

     

       170
       170
       +
           

     

       171
       171
       +
           let indent_str = String.make indent ' ' in

     

       172
       172
       +
           Printf.printf "%s{\n" indent_str;

     

       173
       173
       +
           Printf.printf "%s  \"id\": \"%s\",\n" indent_str id;

     

       174
       174
       +
           Printf.printf "%s  \"name\": \"%s\",\n" indent_str name;

     

       175
       175
       +
           Printf.printf "%s  \"role\": %s,\n" indent_str role;

     

       176
       176
       +
           Printf.printf "%s  \"totalEmails\": %d,\n" indent_str total;

     

       177
       177
       +
           Printf.printf "%s  \"unreadEmails\": %d,\n" indent_str unread;

     

       178
       178
       +
           Printf.printf "%s  \"recentEmails\": %d\n" indent_str recent;

     

       179
       179
       +
           Printf.printf "%s}" indent_str

     

       180
       180
       +
         in

     

       181
       181
       +
         

     

       182
       182
       +
         (* Recursive function to print a tree of mailboxes *)

     

       183
       183
       +
         let rec print_tree_level mailboxes level =

     

       184
       184
       +
           mailboxes |> List.iteri (fun i mailbox ->

     

       185
       185
       +
             let id = Jmap_mailbox.id mailbox in

     

       186
       186
       +
             let name = mailbox_name_with_role mailbox in

     

       187
       187
       +
             let total, unread, recent = get_stats mailbox in

     

       188
       188
       +
             

     

       189
       189
       +
             let indent = String.make (level * 2) ' ' in

     

       190
       190
       +
             let is_last = i = List.length mailboxes - 1 in

     

       191
       191
       +
             let prefix = if level = 0 then "" else

     

       192
       192
       +
                          if is_last then "└── " else "├── " in

     

       193
       193
       +
             

     

       194
       194
       +
             match format with

     

       195
       195
       +
             | `Tree ->

     

       196
       196
       +
                 Printf.printf "%s%s%s" indent prefix name;

     

       197
       197
       +
                 if stats <> Hashtbl.create 0 then

     

       198
       198
       +
                   Printf.printf " (%d emails, %d unread, %d recent)" total unread recent;

     

       199
       199
       +
                 Printf.printf "\n";

     

       200
       200
       +
                 

     

       201
       201
       +
                 (* Print children *)

     

       202
       202
       +
                 let children = find_children id in

     

       203
       203
       +
                 let child_indent = level + 1 in

     

       204
       204
       +
                 print_tree_level children child_indent

     

       205
       205
       +
                 

     

       206
       206
       +
             | `Flat ->

     

       207
       207
       +
                 Printf.printf "%s [%s]\n" name id;

     

       208
       208
       +
                 if stats <> Hashtbl.create 0 then

     

       209
       209
       +
                   Printf.printf "  Emails: %d total, %d unread, %d in last week\n" 

     

       210
       210
       +
                     total unread recent;

     

       211
       211
       +
                 

     

       212
       212
       +
                 (* Print children *)

     

       213
       213
       +
                 let children = find_children id in

     

       214
       214
       +
                 print_tree_level children 0

     

       215
       215
       +
                 

     

       216
       216
       +
             | `Json ->

     

       217
       217
       +
                 print_json_mailbox mailbox (level * 2);

     

       218
       218
       +
                 

     

       219
       219
       +
                 (* Handle commas between mailboxes *)

     

       220
       220
       +
                 let children = find_children id in

     

       221
       221
       +
                 if children <> [] || (not is_last) then Printf.printf ",\n" else Printf.printf "\n";

     

       222
       222
       +
                 

     

       223
       223
       +
                 (* Print children as a "children" array *)

     

       224
       224
       +
                 if children <> [] then begin

     

       225
       225
       +
                   Printf.printf "%s\"children\": [\n" (String.make ((level * 2) + 2) ' ');

     

       226
       226
       +
                   print_tree_level children (level + 2);

     

       227
       227
       +
                   Printf.printf "%s]\n" (String.make ((level * 2) + 2) ' ');

     

       228
       228
       +
                   

     

       229
       229
       +
                   (* Add comma if not the last mailbox *)

     

       230
       230
       +
                   if not is_last then Printf.printf "%s,\n" (String.make (level * 2) ' ');

     

       231
       231
       +
                 end

     

       232
       232
       +
           )

     

       233
       233
       +
         in

     

       234
       234
       +
         

     

       235
       235
       +
         (* Print the mailbox tree *)

     

       236
       236
       +
         match format with

     

       237
       237
       +
         | `Tree | `Flat ->

     

       238
       238
       +
             Printf.printf "Mailboxes:\n";

     

       239
       239
       +
             print_tree_level (find_roots()) 0

     

       240
       240
       +
         | `Json ->

     

       241
       241
       +
             Printf.printf "{\n";

     

       242
       242
       +
             Printf.printf "  \"mailboxes\": [\n";

     

       243
       243
       +
             print_tree_level (find_roots()) 1;

     

       244
       244
       +
             Printf.printf "  ]\n";

     

       245
       245
       +
             Printf.printf "}\n"

     

       246
       246
       +
       

     

       247
       247
       +
       (* Command implementation *)

     

       248
       248
       +
       let mailbox_command host user password list stats mailbox create parent 

     

       249
       249
       +
                            query_mailbox days format : int =

     

       250
       250
       +
         (* Pack arguments into a record for easier passing *)

     

       251
       251
       +
         let args : mailbox_explorer_args = {

     

       252
       252
       +
           list; stats; mailbox; create; parent; 

     

       253
       253
       +
           query_mailbox; days; format

     

       254
       254
       +
         } in

     

       255
       255
       +
         

     

       256
       256
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       257
       257
       +
         Printf.printf "JMAP Mailbox Explorer\n";

     

       258
       258
       +
         Printf.printf "Server: %s\n" host;

     

       259
       259
       +
         Printf.printf "User: %s\n\n" user;

     

       260
       260
       +
         

     

       261
       261
       +
         (* This is where the actual JMAP calls would happen, like:

     

       262
       262
       +
         

     

       263
       263
       +
         let explore_mailboxes () =

     

       264
       264
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       265
       265
       +
             ~host ~username:user ~password 

     

       266
       266
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       267
       267
       +
           

     

       268
       268
       +
           (* Get primary account ID *)

     

       269
       269
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       270
       270
       +
             | Ok id -> id

     

       271
       271
       +
             | Error _ -> failwith "No mail account found"

     

       272
       272
       +
           in

     

       273
       273
       +
           

     

       274
       274
       +
           (* Create a new mailbox if requested *)

     

       275
       275
       +
           if args.create <> None then

     

       276
       276
       +
             let name = Option.get args.create in

     

       277
       277
       +
             let parent_id_opt = match args.parent with

     

       278
       278
       +
               | None -> None

     

       279
       279
       +
               | Some parent_name ->

     

       280
       280
       +
                   (* Resolve parent name to ID - would need to search for it *)

     

       281
       281
       +
                   None (* This would actually find or return an error *)

     

       282
       282
       +
             in

     

       283
       283
       +
             

     

       284
       284
       +
             let create_mailbox = Jmap_mailbox.create 

     

       285
       285
       +
               ~name

     

       286
       286
       +
               ?parent_id:parent_id_opt

     

       287
       287
       +
               () in

     

       288
       288
       +
             

     

       289
       289
       +
             let* result = Jmap_mailbox.set ctx

     

       290
       290
       +
               ~account_id

     

       291
       291
       +
               ~create:(Hashtbl.of_seq (Seq.return ("new", create_mailbox)))

     

       292
       292
       +
               () in

     

       293
       293
       +
             

     

       294
       294
       +
             (* Handle mailbox creation result *)

     

       295
       295
       +
             ...

     

       296
       296
       +
           

     

       297
       297
       +
           (* List mailboxes *)

     

       298
       298
       +
           if args.list || args.stats then

     

       299
       299
       +
             (* Query mailboxes *)

     

       300
       300
       +
             let filter = 

     

       301
       301
       +
               if args.mailbox <> None then

     

       302
       302
       +
                 Jmap_mailbox.filter_name_contains (Option.get args.mailbox)

     

       303
       303
       +
               else

     

       304
       304
       +
                 Jmap_mailbox.Filter.condition (`Assoc [])

     

       305
       305
       +
             in

     

       306
       306
       +
             

     

       307
       307
       +
             let* mailbox_ids = Jmap_mailbox.query ctx

     

       308
       308
       +
               ~account_id

     

       309
       309
       +
               ~filter

     

       310
       310
       +
               ~sort:[Jmap_mailbox.sort_by_name () ]

     

       311
       311
       +
               () in

     

       312
       312
       +
             

     

       313
       313
       +
             match mailbox_ids with

     

       314
       314
       +
             | Error err -> 

     

       315
       315
       +
                 Printf.eprintf "Error querying mailboxes: %s\n" (Jmap.Error.error_to_string err);

     

       316
       316
       +
                 Lwt.return_unit

     

       317
       317
       +
             | Ok (ids, _) ->

     

       318
       318
       +
                 (* Get full mailbox objects *)

     

       319
       319
       +
                 let* mailboxes = Jmap_mailbox.get ctx

     

       320
       320
       +
                   ~account_id

     

       321
       321
       +
                   ~ids

     

       322
       322
       +
                   ~properties:["id"; "name"; "parentId"; "role"; "totalEmails"; "unreadEmails"] in

     

       323
       323
       +
                 

     

       324
       324
       +
                 match mailboxes with

     

       325
       325
       +
                 | Error err ->

     

       326
       326
       +
                     Printf.eprintf "Error getting mailboxes: %s\n" (Jmap.Error.error_to_string err);

     

       327
       327
       +
                     Lwt.return_unit

     

       328
       328
       +
                 | Ok (_, mailbox_list) ->

     

       329
       329
       +
                     (* If stats requested, gather email stats for each mailbox *)

     

       330
       330
       +
                     let* stats_opt = 

     

       331
       331
       +
                       if args.stats then

     

       332
       332
       +
                         (* For each mailbox, gather stats like weekly counts *)

     

       333
       333
       +
                         ...

     

       334
       334
       +
                       else

     

       335
       335
       +
                         Lwt.return (Hashtbl.create 0)

     

       336
       336
       +
                     in

     

       337
       337
       +
                     

     

       338
       338
       +
                     (* Display mailboxes in requested format *)

     

       339
       339
       +
                     display_mailbox_tree mailbox_list args.format stats_opt;

     

       340
       340
       +
                     Lwt.return_unit

     

       341
       341
       +
           

     

       342
       342
       +
           (* Query emails in a specific mailbox *)

     

       343
       343
       +
           if args.query_mailbox <> None then

     

       344
       344
       +
             let mailbox_name = Option.get args.query_mailbox in

     

       345
       345
       +
             

     

       346
       346
       +
             (* Find mailbox ID from name *)

     

       347
       347
       +
             ...

     

       348
       348
       +
             

     

       349
       349
       +
             (* Query emails in that mailbox *)

     

       350
       350
       +
             ...

     

       351
       351
       +
         *)

     

       352
       352
       +
         

     

       353
       353
       +
         if create <> None then

     

       354
       354
       +
           Printf.printf "Creating mailbox: %s\n" (Option.get create);

     

       355
       355
       +
         

     

       356
       356
       +
         if list || stats then

     

       357
       357
       +
           Printf.printf "Listing mailboxes%s:\n" 

     

       358
       358
       +
             (if stats then " with statistics" else "");

     

       359
       359
       +
         

     

       360
       360
       +
         (* Example output for a tree of mailboxes *)

     

       361
       361
       +
         (match format with

     

       362
       362
       +
         | `Tree -> 

     

       363
       363
       +
             Printf.printf "Mailboxes:\n";

     

       364
       364
       +
             Printf.printf "Inbox (14 emails, 3 unread, 5 recent)\n";

     

       365
       365
       +
             Printf.printf "├── Work (8 emails, 2 unread, 3 recent)\n";

     

       366
       366
       +
             Printf.printf "│   └── Project A (3 emails, 1 unread, 2 recent)\n";

     

       367
       367
       +
             Printf.printf "└── Personal (6 emails, 1 unread, 2 recent)\n"

     

       368
       368
       +
         | `Flat ->

     

       369
       369
       +
             Printf.printf "Inbox [mbox1]\n";

     

       370
       370
       +
             Printf.printf "  Emails: 14 total, 3 unread, 5 in last week\n";

     

       371
       371
       +
             Printf.printf "Work [mbox2]\n";

     

       372
       372
       +
             Printf.printf "  Emails: 8 total, 2 unread, 3 in last week\n";

     

       373
       373
       +
             Printf.printf "Project A [mbox3]\n";

     

       374
       374
       +
             Printf.printf "  Emails: 3 total, 1 unread, 2 in last week\n";

     

       375
       375
       +
             Printf.printf "Personal [mbox4]\n";

     

       376
       376
       +
             Printf.printf "  Emails: 6 total, 1 unread, 2 in last week\n"

     

       377
       377
       +
         | `Json ->

     

       378
       378
       +
             Printf.printf "{\n";

     

       379
       379
       +
             Printf.printf "  \"mailboxes\": [\n";

     

       380
       380
       +
             Printf.printf "    {\n";

     

       381
       381
       +
             Printf.printf "      \"id\": \"mbox1\",\n";

     

       382
       382
       +
             Printf.printf "      \"name\": \"Inbox\",\n";

     

       383
       383
       +
             Printf.printf "      \"role\": \"Inbox\",\n";

     

       384
       384
       +
             Printf.printf "      \"totalEmails\": 14,\n";

     

       385
       385
       +
             Printf.printf "      \"unreadEmails\": 3,\n";

     

       386
       386
       +
             Printf.printf "      \"recentEmails\": 5\n";

     

       387
       387
       +
             Printf.printf "    }\n";

     

       388
       388
       +
             Printf.printf "  ]\n";

     

       389
       389
       +
             Printf.printf "}\n");

     

       390
       390
       +
         

     

       391
       391
       +
         if query_mailbox <> None then

     

       392
       392
       +
           Printf.printf "\nQuerying emails in mailbox: %s\n" (Option.get query_mailbox);

     

       393
       393
       +
         

     

       394
       394
       +
         (* Since we're only type checking, we'll exit with success *)

     

       395
       395
       +
         0

     

       396
       396
       +
       

     

       397
       397
       +
       (* Command definition *)

     

       398
       398
       +
       let mailbox_cmd =

     

       399
       399
       +
         let doc = "explore and manage mailboxes using JMAP" in

     

       400
       400
       +
         let man = [

     

       401
       401
       +
           `S Manpage.s_description;

     

       402
       402
       +
           `P "Lists, creates, and analyzes email mailboxes using JMAP.";

     

       403
       403
       +
           `P "Demonstrates JMAP's mailbox query and management capabilities.";

     

       404
       404
       +
           `S Manpage.s_examples;

     

       405
       405
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";

     

       406
       406
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --stats --mailbox Inbox";

     

       407
       407
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --create \"Work/Project X\" --parent Work";

     

       408
       408
       +
         ] in

     

       409
       409
       +
         

     

       410
       410
       +
         let cmd = 

     

       411
       411
       +
           Cmd.v 

     

       412
       412
       +
             (Cmd.info "jmap-mailbox-explorer" ~version:"1.0" ~doc ~man)

     

       413
       413
       +
             Term.(const mailbox_command $ host_arg $ user_arg $ password_arg $ 

     

       414
       414
       +
                    list_arg $ stats_arg $ mailbox_arg $ create_arg $ 

     

       415
       415
       +
                    parent_arg $ query_mailbox_arg $ days_arg $ format_arg)

     

       416
       416
       +
         in

     

       417
       417
       +
         cmd

     

       418
       418
       +
       

     

       419
       419
       +
       (* Main entry point *)

     

       420
       420
       +
       let () = exit (Cmd.eval' mailbox_cmd)

+238

bin/jmap_push_listener.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_push_listener.ml - Monitor real-time changes via JMAP push notifications

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's push notification capabilities for monitoring

     

       5
       5
       +
        * changes to emails, mailboxes, and other data in real-time.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Push notification types to monitor **)

     

       13
       13
       +
       type monitor_types = {

     

       14
       14
       +
         emails : bool;

     

       15
       15
       +
         mailboxes : bool;

     

       16
       16
       +
         threads : bool;

     

       17
       17
       +
         identities : bool;

     

       18
       18
       +
         submissions : bool;

     

       19
       19
       +
         all : bool;

     

       20
       20
       +
       }

     

       21
       21
       +
       

     

       22
       22
       +
       (** Command-line arguments **)

     

       23
       23
       +
       

     

       24
       24
       +
       let host_arg =

     

       25
       25
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       26
       26
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       27
       27
       +
       

     

       28
       28
       +
       let user_arg =

     

       29
       29
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       30
       30
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       31
       31
       +
       

     

       32
       32
       +
       let password_arg =

     

       33
       33
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       34
       34
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       35
       35
       +
       

     

       36
       36
       +
       let monitor_emails_arg =

     

       37
       37
       +
         Arg.(value & flag & info ["emails"] 

     

       38
       38
       +
              ~doc:"Monitor email changes")

     

       39
       39
       +
       

     

       40
       40
       +
       let monitor_mailboxes_arg =

     

       41
       41
       +
         Arg.(value & flag & info ["mailboxes"] 

     

       42
       42
       +
              ~doc:"Monitor mailbox changes")

     

       43
       43
       +
       

     

       44
       44
       +
       let monitor_threads_arg =

     

       45
       45
       +
         Arg.(value & flag & info ["threads"] 

     

       46
       46
       +
              ~doc:"Monitor thread changes")

     

       47
       47
       +
       

     

       48
       48
       +
       let monitor_identities_arg =

     

       49
       49
       +
         Arg.(value & flag & info ["identities"] 

     

       50
       50
       +
              ~doc:"Monitor identity changes")

     

       51
       51
       +
       

     

       52
       52
       +
       let monitor_submissions_arg =

     

       53
       53
       +
         Arg.(value & flag & info ["submissions"] 

     

       54
       54
       +
              ~doc:"Monitor email submission changes")

     

       55
       55
       +
       

     

       56
       56
       +
       let monitor_all_arg =

     

       57
       57
       +
         Arg.(value & flag & info ["all"] 

     

       58
       58
       +
              ~doc:"Monitor all supported types")

     

       59
       59
       +
       

     

       60
       60
       +
       let verbose_arg =

     

       61
       61
       +
         Arg.(value & flag & info ["v"; "verbose"] 

     

       62
       62
       +
              ~doc:"Show detailed information about changes")

     

       63
       63
       +
       

     

       64
       64
       +
       let timeout_arg =

     

       65
       65
       +
         Arg.(value & opt int 300 & info ["t"; "timeout"] 

     

       66
       66
       +
              ~docv:"SECONDS" ~doc:"Timeout for push connections (default: 300)")

     

       67
       67
       +
       

     

       68
       68
       +
       (** Helper functions **)

     

       69
       69
       +
       

     

       70
       70
       +
       (* Format timestamp *)

     

       71
       71
       +
       let format_timestamp () =

     

       72
       72
       +
         let time = Unix.gettimeofday () in

     

       73
       73
       +
         let tm = Unix.localtime time in

     

       74
       74
       +
         Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"

     

       75
       75
       +
           (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       76
       76
       +
           tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec

     

       77
       77
       +
       

     

       78
       78
       +
       (* Print change notification *)

     

       79
       79
       +
       let print_change data_type change_type details verbose =

     

       80
       80
       +
         let timestamp = format_timestamp () in

     

       81
       81
       +
         Printf.printf "[%s] %s %s" timestamp data_type change_type;

     

       82
       82
       +
         if verbose && details <> "" then

     

       83
       83
       +
           Printf.printf ": %s" details;

     

       84
       84
       +
         Printf.printf "\n";

     

       85
       85
       +
         flush stdout

     

       86
       86
       +
       

     

       87
       87
       +
       (* Monitor using polling simulation *)

     

       88
       88
       +
       let monitor_changes _ctx _session _account_id monitor verbose timeout =

     

       89
       89
       +
         Printf.printf "Starting change monitoring (simulated)...\n\n";

     

       90
       90
       +
         

     

       91
       91
       +
         (* Types to monitor *)

     

       92
       92
       +
         let types = ref [] in

     

       93
       93
       +
         if monitor.emails || monitor.all then types := "Email" :: !types;

     

       94
       94
       +
         if monitor.mailboxes || monitor.all then types := "Mailbox" :: !types;

     

       95
       95
       +
         if monitor.threads || monitor.all then types := "Thread" :: !types;

     

       96
       96
       +
         if monitor.identities || monitor.all then types := "Identity" :: !types;

     

       97
       97
       +
         if monitor.submissions || monitor.all then types := "EmailSubmission" :: !types;

     

       98
       98
       +
         

     

       99
       99
       +
         Printf.printf "Monitoring: %s\n\n" (String.concat ", " !types);

     

       100
       100
       +
         

     

       101
       101
       +
         (* In a real implementation, we would:

     

       102
       102
       +
            1. Use EventSource or long polling

     

       103
       103
       +
            2. Track state changes per type

     

       104
       104
       +
            3. Fetch and display actual changes

     

       105
       105
       +
            

     

       106
       106
       +
            For this demo, we'll simulate monitoring *)

     

       107
       107
       +
         

     

       108
       108
       +
         let rec monitor_loop count =

     

       109
       109
       +
           (* Make a simple echo request to stay connected *)

     

       110
       110
       +
           let invocation = Jmap.Wire.Invocation.v

     

       111
       111
       +
             ~method_name:"Core/echo"

     

       112
       112
       +
             ~arguments:(`Assoc ["ping", `String "keepalive"]) 

     

       113
       113
       +
             ~method_call_id:"echo1"

     

       114
       114
       +
             () in

     

       115
       115
       +
             

     

       116
       116
       +
           let request = Jmap.Wire.Request.v

     

       117
       117
       +
             ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       118
       118
       +
             ~method_calls:[invocation]

     

       119
       119
       +
             () in

     

       120
       120
       +
             

     

       121
       121
       +
           match Jmap_unix.request _ctx request with

     

       122
       122
       +
           | Ok _ ->

     

       123
       123
       +
               (* Simulate random changes for demonstration *)

     

       124
       124
       +
               if count mod 3 = 0 && !types <> [] then (

     

       125
       125
       +
                 let changed_type = List.nth !types (Random.int (List.length !types)) in

     

       126
       126
       +
                 let change_details = match changed_type with

     

       127
       127
       +
                   | "Email" -> "2 new, 1 updated"

     

       128
       128
       +
                   | "Mailbox" -> "1 updated (Inbox)"

     

       129
       129
       +
                   | "Thread" -> "3 updated"

     

       130
       130
       +
                   | "Identity" -> "settings changed"

     

       131
       131
       +
                   | "EmailSubmission" -> "1 sent"

     

       132
       132
       +
                   | _ -> "changed"

     

       133
       133
       +
                 in

     

       134
       134
       +
                 print_change changed_type "changed" change_details verbose

     

       135
       135
       +
               );

     

       136
       136
       +
               

     

       137
       137
       +
               (* Wait before next check *)

     

       138
       138
       +
               Unix.sleep 5;

     

       139
       139
       +
               

     

       140
       140
       +
               if count < timeout / 5 then

     

       141
       141
       +
                 monitor_loop (count + 1)

     

       142
       142
       +
               else (

     

       143
       143
       +
                 Printf.printf "\nMonitoring timeout reached.\n";

     

       144
       144
       +
                 0

     

       145
       145
       +
               )

     

       146
       146
       +
           | Error e ->

     

       147
       147
       +
               Printf.eprintf "Connection error: %s\n" (Jmap.Error.error_to_string e);

     

       148
       148
       +
               1

     

       149
       149
       +
         in

     

       150
       150
       +
         

     

       151
       151
       +
         monitor_loop 0

     

       152
       152
       +
       

     

       153
       153
       +
       (* Command implementation *)

     

       154
       154
       +
       let listen_command host user password emails mailboxes threads identities 

     

       155
       155
       +
                          submissions all verbose timeout : int =

     

       156
       156
       +
         Printf.printf "JMAP Push Listener\n";

     

       157
       157
       +
         Printf.printf "Server: %s\n" host;

     

       158
       158
       +
         Printf.printf "User: %s\n\n" user;

     

       159
       159
       +
         

     

       160
       160
       +
         (* Build monitor options *)

     

       161
       161
       +
         let monitor = {

     

       162
       162
       +
           emails;

     

       163
       163
       +
           mailboxes;

     

       164
       164
       +
           threads;

     

       165
       165
       +
           identities;

     

       166
       166
       +
           submissions;

     

       167
       167
       +
           all;

     

       168
       168
       +
         } in

     

       169
       169
       +
         

     

       170
       170
       +
         (* Check that at least one type is selected *)

     

       171
       171
       +
         if not (emails || mailboxes || threads || identities || submissions || all) then (

     

       172
       172
       +
           Printf.eprintf "Error: Must specify at least one type to monitor (or --all)\n";

     

       173
       173
       +
           exit 1

     

       174
       174
       +
         );

     

       175
       175
       +
         

     

       176
       176
       +
         (* Initialize random for simulation *)

     

       177
       177
       +
         Random.self_init ();

     

       178
       178
       +
         

     

       179
       179
       +
         (* Connect to server *)

     

       180
       180
       +
         let ctx = Jmap_unix.create_client () in

     

       181
       181
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       182
       182
       +
         

     

       183
       183
       +
         let (ctx, session) = match result with

     

       184
       184
       +
           | Ok (ctx, session) -> (ctx, session)

     

       185
       185
       +
           | Error e -> 

     

       186
       186
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       187
       187
       +
               exit 1

     

       188
       188
       +
         in

     

       189
       189
       +
         

     

       190
       190
       +
         (* Get the primary account ID *)

     

       191
       191
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       192
       192
       +
           | Ok id -> id

     

       193
       193
       +
           | Error e -> 

     

       194
       194
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       195
       195
       +
               exit 1

     

       196
       196
       +
         in

     

       197
       197
       +
         

     

       198
       198
       +
         (* Check EventSource URL availability *)

     

       199
       199
       +
         let event_source_url = Jmap.Session.Session.event_source_url session in

     

       200
       200
       +
         if Uri.to_string event_source_url <> "" then

     

       201
       201
       +
           Printf.printf "Note: Server supports EventSource at: %s\n\n" (Uri.to_string event_source_url)

     

       202
       202
       +
         else

     

       203
       203
       +
           Printf.printf "Note: Server doesn't advertise EventSource support\n\n";

     

       204
       204
       +
         

     

       205
       205
       +
         (* Monitor for changes *)

     

       206
       206
       +
         monitor_changes ctx session account_id monitor verbose timeout

     

       207
       207
       +
       

     

       208
       208
       +
       (* Command definition *)

     

       209
       209
       +
       let listen_cmd =

     

       210
       210
       +
         let doc = "monitor real-time changes via JMAP push notifications" in

     

       211
       211
       +
         let man = [

     

       212
       212
       +
           `S Manpage.s_description;

     

       213
       213
       +
           `P "Monitor real-time changes to JMAP data using push notifications.";

     

       214
       214
       +
           `P "Supports both EventSource and long-polling methods.";

     

       215
       215
       +
           `P "Shows when emails, mailboxes, threads, and other data change.";

     

       216
       216
       +
           `S Manpage.s_examples;

     

       217
       217
       +
           `P "Monitor all changes:";

     

       218
       218
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --all";

     

       219
       219
       +
           `P "";

     

       220
       220
       +
           `P "Monitor only emails and mailboxes with details:";

     

       221
       221
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --emails --mailboxes -v";

     

       222
       222
       +
           `P "";

     

       223
       223
       +
           `P "Monitor with custom timeout:";

     

       224
       224
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --all -t 600";

     

       225
       225
       +
         ] in

     

       226
       226
       +
         

     

       227
       227
       +
         let cmd =

     

       228
       228
       +
           Cmd.v

     

       229
       229
       +
             (Cmd.info "jmap-push-listener" ~version:"1.0" ~doc ~man)

     

       230
       230
       +
             Term.(const listen_command $ host_arg $ user_arg $ password_arg $ 

     

       231
       231
       +
                   monitor_emails_arg $ monitor_mailboxes_arg $ monitor_threads_arg $

     

       232
       232
       +
                   monitor_identities_arg $ monitor_submissions_arg $ monitor_all_arg $

     

       233
       233
       +
                   verbose_arg $ timeout_arg)

     

       234
       234
       +
         in

     

       235
       235
       +
         cmd

     

       236
       236
       +
       

     

       237
       237
       +
       (* Main entry point *)

     

       238
       238
       +
       let () = exit (Cmd.eval' listen_cmd)

+533

bin/jmap_thread_analyzer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_thread_analyzer.ml - A tool for analyzing email threads using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates the thread-related capabilities of JMAP,

     

       5
       5
       +
        * allowing visualization and analysis of conversation threads.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* Dummy Unix module for type checking *)

     

       20
       20
       +
       module Unix = struct

     

       21
       21
       +
         type tm = {

     

       22
       22
       +
           tm_sec : int;

     

       23
       23
       +
           tm_min : int;

     

       24
       24
       +
           tm_hour : int;

     

       25
       25
       +
           tm_mday : int;

     

       26
       26
       +
           tm_mon : int;

     

       27
       27
       +
           tm_year : int;

     

       28
       28
       +
           tm_wday : int;

     

       29
       29
       +
           tm_yday : int;

     

       30
       30
       +
           tm_isdst : bool

     

       31
       31
       +
         }

     

       32
       32
       +
         

     

       33
       33
       +
         let time () = 0.0

     

       34
       34
       +
         let gettimeofday () = 0.0

     

       35
       35
       +
         let mktime tm = (0.0, tm)

     

       36
       36
       +
         let gmtime _time = {

     

       37
       37
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       39
       39
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       40
       40
       +
         }

     

       41
       41
       +
         

     

       42
       42
       +
         (* JMAP connection function - would be in a real implementation *)

     

       43
       43
       +
         let connect ~host ~username ~password ?auth_method () =

     

       44
       44
       +
           failwith "Not implemented"

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (* Dummy ISO8601 module *)

     

       48
       48
       +
       module ISO8601 = struct

     

       49
       49
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** Thread analyzer arguments *)

     

       53
       53
       +
       type thread_analyzer_args = {

     

       54
       54
       +
         thread_id : string option;

     

       55
       55
       +
         search : string option;

     

       56
       56
       +
         limit : int;

     

       57
       57
       +
         days : int;

     

       58
       58
       +
         subject : string option;

     

       59
       59
       +
         participants : string list;

     

       60
       60
       +
         format : [`Summary | `Detailed | `Timeline | `Graph];

     

       61
       61
       +
         include_body : bool;

     

       62
       62
       +
       }

     

       63
       63
       +
       

     

       64
       64
       +
       (* Email filter helpers - stub implementations for type checking *)

     

       65
       65
       +
       module Email_filter = struct

     

       66
       66
       +
         let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])

     

       67
       67
       +
         let subject subj = Filter.condition (`Assoc [("subject", `String subj)])

     

       68
       68
       +
         let from email = Filter.condition (`Assoc [("from", `String email)])

     

       69
       69
       +
         let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])

     

       70
       70
       +
         let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])

     

       71
       71
       +
         let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])

     

       72
       72
       +
         let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])

     

       73
       73
       +
         let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])

     

       74
       74
       +
         let to_ email = Filter.condition (`Assoc [("to", `String email)])

     

       75
       75
       +
       end

     

       76
       76
       +
       

     

       77
       77
       +
       (* Thread module stub *)

     

       78
       78
       +
       module Thread = struct

     

       79
       79
       +
         type t = {

     

       80
       80
       +
           id : string;

     

       81
       81
       +
           email_ids : string list;

     

       82
       82
       +
         }

     

       83
       83
       +
         

     

       84
       84
       +
         let id thread = thread.id

     

       85
       85
       +
         let email_ids thread = thread.email_ids

     

       86
       86
       +
       end

     

       87
       87
       +
       

     

       88
       88
       +
       (** Command-line arguments **)

     

       89
       89
       +
       

     

       90
       90
       +
       let host_arg =

     

       91
       91
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       92
       92
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       93
       93
       +
       

     

       94
       94
       +
       let user_arg =

     

       95
       95
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       96
       96
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       97
       97
       +
       

     

       98
       98
       +
       let password_arg =

     

       99
       99
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       100
       100
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       101
       101
       +
       

     

       102
       102
       +
       let thread_id_arg =

     

       103
       103
       +
         Arg.(value & opt (some string) None & info ["t"; "thread"] 

     

       104
       104
       +
              ~docv:"THREAD_ID" ~doc:"Analyze specific thread by ID")

     

       105
       105
       +
       

     

       106
       106
       +
       let search_arg =

     

       107
       107
       +
         Arg.(value & opt (some string) None & info ["search"] 

     

       108
       108
       +
              ~docv:"QUERY" ~doc:"Search for threads containing text")

     

       109
       109
       +
       

     

       110
       110
       +
       let limit_arg =

     

       111
       111
       +
         Arg.(value & opt int 10 & info ["limit"] 

     

       112
       112
       +
              ~docv:"N" ~doc:"Maximum number of threads to display")

     

       113
       113
       +
       

     

       114
       114
       +
       let days_arg =

     

       115
       115
       +
         Arg.(value & opt int 30 & info ["days"] 

     

       116
       116
       +
              ~docv:"DAYS" ~doc:"Limit to threads from the past N days")

     

       117
       117
       +
       

     

       118
       118
       +
       let subject_arg =

     

       119
       119
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       120
       120
       +
              ~docv:"SUBJECT" ~doc:"Search threads by subject")

     

       121
       121
       +
       

     

       122
       122
       +
       let participant_arg =

     

       123
       123
       +
         Arg.(value & opt_all string [] & info ["participant"] 

     

       124
       124
       +
              ~docv:"EMAIL" ~doc:"Filter by participant email")

     

       125
       125
       +
       

     

       126
       126
       +
       let format_arg =

     

       127
       127
       +
         Arg.(value & opt (enum [

     

       128
       128
       +
           "summary", `Summary;

     

       129
       129
       +
           "detailed", `Detailed;

     

       130
       130
       +
           "timeline", `Timeline;

     

       131
       131
       +
           "graph", `Graph;

     

       132
       132
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       133
       133
       +
       

     

       134
       134
       +
       let include_body_arg =

     

       135
       135
       +
         Arg.(value & flag & info ["include-body"] ~doc:"Include message bodies in output")

     

       136
       136
       +
       

     

       137
       137
       +
       (** Thread Analysis Functionality **)

     

       138
       138
       +
       

     

       139
       139
       +
       (* Calculate days ago from a date *)

     

       140
       140
       +
       let days_ago date =

     

       141
       141
       +
         let now = Unix.gettimeofday() in

     

       142
       142
       +
         int_of_float ((now -. date) /. 86400.0)

     

       143
       143
       +
       

     

       144
       144
       +
       (* Parse out email addresses from a participant string - simple version *)

     

       145
       145
       +
       let extract_email participant =

     

       146
       146
       +
         if String.contains participant '@' then participant

     

       147
       147
       +
         else participant ^ "@example.com" (* Default domain if none provided *)

     

       148
       148
       +
       

     

       149
       149
       +
       (* Create filter for thread queries *)

     

       150
       150
       +
       let create_thread_filter args =

     

       151
       151
       +
         let open Email_filter in

     

       152
       152
       +
         let filters = [] in

     

       153
       153
       +
         

     

       154
       154
       +
         (* Add search text condition *)

     

       155
       155
       +
         let filters = match args.search with

     

       156
       156
       +
           | None -> filters

     

       157
       157
       +
           | Some text -> create_fulltext_filter text :: filters

     

       158
       158
       +
         in

     

       159
       159
       +
         

     

       160
       160
       +
         (* Add subject condition *)

     

       161
       161
       +
         let filters = match args.subject with

     

       162
       162
       +
           | None -> filters

     

       163
       163
       +
           | Some subj -> Email_filter.subject subj :: filters

     

       164
       164
       +
         in

     

       165
       165
       +
         

     

       166
       166
       +
         (* Add date range based on days *)

     

       167
       167
       +
         let filters =

     

       168
       168
       +
           if args.days > 0 then

     

       169
       169
       +
             let now = Unix.gettimeofday() in

     

       170
       170
       +
             let past = now -. (float_of_int args.days *. 86400.0) in

     

       171
       171
       +
             after past :: filters

     

       172
       172
       +
           else

     

       173
       173
       +
             filters

     

       174
       174
       +
         in

     

       175
       175
       +
         

     

       176
       176
       +
         (* Add participant filters *)

     

       177
       177
       +
         let filters =

     

       178
       178
       +
           List.fold_left (fun acc participant ->

     

       179
       179
       +
             let email = extract_email participant in

     

       180
       180
       +
             (* This would need more complex logic to check both from and to fields *)

     

       181
       181
       +
             from email :: acc

     

       182
       182
       +
           ) filters args.participants

     

       183
       183
       +
         in

     

       184
       184
       +
         

     

       185
       185
       +
         (* Combine all filters with AND *)

     

       186
       186
       +
         match filters with

     

       187
       187
       +
         | [] -> Filter.condition (`Assoc [])  (* Empty filter *)

     

       188
       188
       +
         | [f] -> f

     

       189
       189
       +
         | filters -> Filter.and_ filters

     

       190
       190
       +
       

     

       191
       191
       +
       (* Display thread in requested format *)

     

       192
       192
       +
       let display_thread thread emails format include_body snippet_map =

     

       193
       193
       +
         let thread_id = Thread.id thread in

     

       194
       194
       +
         let email_count = List.length (Thread.email_ids thread) in

     

       195
       195
       +
         

     

       196
       196
       +
         (* Sort emails by date for proper display order *)

     

       197
       197
       +
         let sorted_emails = List.sort (fun e1 e2 ->

     

       198
       198
       +
           let date1 = Option.value (Types.Email.received_at e1) ~default:0.0 in

     

       199
       199
       +
           let date2 = Option.value (Types.Email.received_at e2) ~default:0.0 in

     

       200
       200
       +
           compare date1 date2

     

       201
       201
       +
         ) emails in

     

       202
       202
       +
         

     

       203
       203
       +
         (* Get a snippet for an email if available *)

     

       204
       204
       +
         let get_snippet email_id =

     

       205
       205
       +
           match Hashtbl.find_opt snippet_map email_id with

     

       206
       206
       +
           | Some snippet -> snippet

     

       207
       207
       +
           | None -> "(No preview available)"

     

       208
       208
       +
         in

     

       209
       209
       +
         

     

       210
       210
       +
         match format with

     

       211
       211
       +
         | `Summary ->

     

       212
       212
       +
             Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;

     

       213
       213
       +
             

     

       214
       214
       +
             (* Print first email subject as thread subject *)

     

       215
       215
       +
             (match sorted_emails with

     

       216
       216
       +
             | first :: _ ->

     

       217
       217
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       218
       218
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       219
       219
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       220
       220
       +
             

     

       221
       221
       +
             (* List participants *)

     

       222
       222
       +
             let participants = sorted_emails |> List.fold_left (fun acc email ->

     

       223
       223
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       224
       224
       +
               from_list |> List.fold_left (fun acc addr ->

     

       225
       225
       +
                 let email = Types.Email_address.email addr in

     

       226
       226
       +
                 if not (List.mem email acc) then email :: acc else acc

     

       227
       227
       +
               ) acc

     

       228
       228
       +
             ) [] in

     

       229
       229
       +
             

     

       230
       230
       +
             Printf.printf "Participants: %s\n\n" (String.concat ", " participants);

     

       231
       231
       +
             

     

       232
       232
       +
             (* Show timespan *)

     

       233
       233
       +
             (match sorted_emails with

     

       234
       234
       +
             | first :: _ :: _ :: _ -> (* At least a few messages *)

     

       235
       235
       +
                 let first_date = Option.value (Types.Email.received_at first) ~default:0.0 in

     

       236
       236
       +
                 let last_date = Option.value (Types.Email.received_at (List.hd (List.rev sorted_emails))) ~default:0.0 in

     

       237
       237
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in

     

       238
       238
       +
                 let first_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       239
       239
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in

     

       240
       240
       +
                 let last_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       241
       241
       +
                 let duration_days = int_of_float ((last_date -. first_date) /. 86400.0) in

     

       242
       242
       +
                 Printf.printf "Timespan: %s to %s (%d days)\n\n" first_str last_str duration_days

     

       243
       243
       +
             | _ -> ());

     

       244
       244
       +
             

     

       245
       245
       +
             (* Show message count by participant *)

     

       246
       246
       +
             let message_counts = sorted_emails |> List.fold_left (fun acc email ->

     

       247
       247
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       248
       248
       +
               match from_list with

     

       249
       249
       +
               | addr :: _ ->

     

       250
       250
       +
                   let email = Types.Email_address.email addr in

     

       251
       251
       +
                   let count = try Hashtbl.find acc email with Not_found -> 0 in

     

       252
       252
       +
                   Hashtbl.replace acc email (count + 1);

     

       253
       253
       +
                   acc

     

       254
       254
       +
               | [] -> acc

     

       255
       255
       +
             ) (Hashtbl.create 10) in

     

       256
       256
       +
             

     

       257
       257
       +
             Printf.printf "Messages per participant:\n";

     

       258
       258
       +
             Hashtbl.iter (fun email count ->

     

       259
       259
       +
               Printf.printf "  %s: %d messages\n" email count

     

       260
       260
       +
             ) message_counts;

     

       261
       261
       +
             Printf.printf "\n"

     

       262
       262
       +
         

     

       263
       263
       +
         | `Detailed ->

     

       264
       264
       +
             Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;

     

       265
       265
       +
             

     

       266
       266
       +
             (* Print detailed information for each email *)

     

       267
       267
       +
             sorted_emails |> List.iteri (fun i email ->

     

       268
       268
       +
               let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       269
       269
       +
               let subject = Option.value (Types.Email.subject email) ~default:"(No subject)" in

     

       270
       270
       +
               

     

       271
       271
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       272
       272
       +
               let from = match from_list with

     

       273
       273
       +
                 | addr :: _ -> Types.Email_address.email addr

     

       274
       274
       +
                 | [] -> "(unknown)"

     

       275
       275
       +
               in

     

       276
       276
       +
               

     

       277
       277
       +
               let date = match Types.Email.received_at email with

     

       278
       278
       +
                 | Some d ->

     

       279
       279
       +
                     let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in

     

       280
       280
       +
                     String.sub datetime_str 0 (min 19 (String.length datetime_str))

     

       281
       281
       +
                 | None -> "(unknown)"

     

       282
       282
       +
               in

     

       283
       283
       +
               

     

       284
       284
       +
               let days = match Types.Email.received_at email with

     

       285
       285
       +
                 | Some d -> Printf.sprintf " (%d days ago)" (days_ago d)

     

       286
       286
       +
                 | None -> ""

     

       287
       287
       +
               in

     

       288
       288
       +
               

     

       289
       289
       +
               Printf.printf "Email %d of %d:\n" (i+1) email_count;

     

       290
       290
       +
               Printf.printf "  ID:      %s\n" id;

     

       291
       291
       +
               Printf.printf "  Subject: %s\n" subject;

     

       292
       292
       +
               Printf.printf "  From:    %s\n" from;

     

       293
       293
       +
               Printf.printf "  Date:    %s%s\n" date days;

     

       294
       294
       +
               

     

       295
       295
       +
               let keywords = match Types.Email.keywords email with

     

       296
       296
       +
                 | Some kw -> Types.Keywords.custom_keywords kw |> String.concat ", "

     

       297
       297
       +
                 | None -> "(none)"

     

       298
       298
       +
               in

     

       299
       299
       +
               if keywords <> "(none)" then

     

       300
       300
       +
                 Printf.printf "  Flags:   %s\n" keywords;

     

       301
       301
       +
               

     

       302
       302
       +
               (* Show preview from snippet if available *)

     

       303
       303
       +
               Printf.printf "  Snippet: %s\n" (get_snippet id);

     

       304
       304
       +
               

     

       305
       305
       +
               (* Show message body if requested *)

     

       306
       306
       +
               if include_body then

     

       307
       307
       +
                 match Types.Email.text_body email with

     

       308
       308
       +
                 | Some parts when parts <> [] ->

     

       309
       309
       +
                     let first_part = List.hd parts in

     

       310
       310
       +
                     Printf.printf "  Body: %s\n" "(body content would be here in real implementation)";

     

       311
       311
       +
                 | _ -> ();

     

       312
       312
       +
               

     

       313
       313
       +
               Printf.printf "\n"

     

       314
       314
       +
             )

     

       315
       315
       +
         

     

       316
       316
       +
         | `Timeline ->

     

       317
       317
       +
             Printf.printf "Timeline for Thread: %s\n\n" thread_id;

     

       318
       318
       +
             

     

       319
       319
       +
             (* Get the first email's subject as thread subject *)

     

       320
       320
       +
             (match sorted_emails with

     

       321
       321
       +
             | first :: _ ->

     

       322
       322
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       323
       323
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       324
       324
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       325
       325
       +
             

     

       326
       326
       +
             (* Create a timeline visualization *)

     

       327
       327
       +
             if sorted_emails = [] then

     

       328
       328
       +
               Printf.printf "No emails to display\n"

     

       329
       329
       +
             else

     

       330
       330
       +
               let first_email = List.hd sorted_emails in

     

       331
       331
       +
               let last_email = List.hd (List.rev sorted_emails) in

     

       332
       332
       +
               

     

       333
       333
       +
               let first_date = Option.value (Types.Email.received_at first_email) ~default:0.0 in

     

       334
       334
       +
               let last_date = Option.value (Types.Email.received_at last_email) ~default:0.0 in

     

       335
       335
       +
               

     

       336
       336
       +
               let total_duration = max 1.0 (last_date -. first_date) in

     

       337
       337
       +
               let timeline_width = 50 in

     

       338
       338
       +
               

     

       339
       339
       +
               let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in

     

       340
       340
       +
               let start_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       341
       341
       +
               Printf.printf "Start date: %s\n" start_str;

     

       342
       342
       +
               

     

       343
       343
       +
               let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in

     

       344
       344
       +
               let end_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       345
       345
       +
               Printf.printf "End date:   %s\n\n" end_str;

     

       346
       346
       +
               

     

       347
       347
       +
               Printf.printf "Timeline: [%s]\n" (String.make timeline_width '-');

     

       348
       348
       +
               

     

       349
       349
       +
               sorted_emails |> List.iteri (fun i email ->

     

       350
       350
       +
                 let date = Option.value (Types.Email.received_at email) ~default:0.0 in

     

       351
       351
       +
                 let position = int_of_float (float_of_int timeline_width *. (date -. first_date) /. total_duration) in

     

       352
       352
       +
                 

     

       353
       353
       +
                 let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       354
       354
       +
                 let from = match from_list with

     

       355
       355
       +
                   | addr :: _ -> Types.Email_address.email addr

     

       356
       356
       +
                   | [] -> "(unknown)"

     

       357
       357
       +
                 in

     

       358
       358
       +
                 

     

       359
       359
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime date) in

     

       360
       360
       +
                 let date_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       361
       361
       +
                 

     

       362
       362
       +
                 let marker = String.make timeline_width ' ' |> String.mapi (fun j c ->

     

       363
       363
       +
                   if j = position then '*' else if j < position then ' ' else c

     

       364
       364
       +
                 ) in

     

       365
       365
       +
                 

     

       366
       366
       +
                 Printf.printf "%s [%s] %s: %s\n" date_str marker from (get_snippet (Option.value (Types.Email.id email) ~default:""))

     

       367
       367
       +
               );

     

       368
       368
       +
               

     

       369
       369
       +
               Printf.printf "\n"

     

       370
       370
       +
         

     

       371
       371
       +
         | `Graph ->

     

       372
       372
       +
             Printf.printf "Thread Graph for: %s\n\n" thread_id;

     

       373
       373
       +
             

     

       374
       374
       +
             (* In a real implementation, this would build a proper thread graph based on

     

       375
       375
       +
                In-Reply-To and References headers. For this demo, we'll just show a simple tree. *)

     

       376
       376
       +
             

     

       377
       377
       +
             (* Get the first email's subject as thread subject *)

     

       378
       378
       +
             (match sorted_emails with

     

       379
       379
       +
             | first :: _ ->

     

       380
       380
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       381
       381
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       382
       382
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       383
       383
       +
             

     

       384
       384
       +
             (* Create a simple thread tree visualization *)

     

       385
       385
       +
             if sorted_emails = [] then

     

       386
       386
       +
               Printf.printf "No emails to display\n"

     

       387
       387
       +
             else

     

       388
       388
       +
               let indent level = String.make (level * 2) ' ' in

     

       389
       389
       +
               

     

       390
       390
       +
               (* Very simplified threading model - in a real implementation, 

     

       391
       391
       +
                  this would use In-Reply-To and References headers *)

     

       392
       392
       +
               sorted_emails |> List.iteri (fun i email ->

     

       393
       393
       +
                 let level = min i 4 in  (* Simplified nesting - would be based on real reply chain *)

     

       394
       394
       +
                 

     

       395
       395
       +
                 let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       396
       396
       +
                 

     

       397
       397
       +
                 let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       398
       398
       +
                 let from = match from_list with

     

       399
       399
       +
                   | addr :: _ -> Types.Email_address.email addr

     

       400
       400
       +
                   | [] -> "(unknown)"

     

       401
       401
       +
                 in

     

       402
       402
       +
                 

     

       403
       403
       +
                 let date = match Types.Email.received_at email with

     

       404
       404
       +
                   | Some d -> 

     

       405
       405
       +
                       let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in

     

       406
       406
       +
                       String.sub datetime_str 0 (min 19 (String.length datetime_str))

     

       407
       407
       +
                   | None -> "(unknown)"

     

       408
       408
       +
                 in

     

       409
       409
       +
                 

     

       410
       410
       +
                 Printf.printf "%s%s [%s] %s\n" 

     

       411
       411
       +
                   (indent level) 

     

       412
       412
       +
                   (if level = 0 then "+" else if level = 1 then "|-" else "|--")

     

       413
       413
       +
                   date from;

     

       414
       414
       +
                 

     

       415
       415
       +
                 Printf.printf "%s%s\n" (indent (level + 4)) (get_snippet id);

     

       416
       416
       +
               );

     

       417
       417
       +
               

     

       418
       418
       +
               Printf.printf "\n"

     

       419
       419
       +
       

     

       420
       420
       +
       (* Command implementation *)

     

       421
       421
       +
       let thread_command host user password thread_id search limit days subject 

     

       422
       422
       +
                           participant format include_body : int =

     

       423
       423
       +
         (* Pack arguments into a record for easier passing *)

     

       424
       424
       +
         let args : thread_analyzer_args = {

     

       425
       425
       +
           thread_id; search; limit; days; subject; 

     

       426
       426
       +
           participants = participant; format; include_body

     

       427
       427
       +
         } in

     

       428
       428
       +
         

     

       429
       429
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       430
       430
       +
         Printf.printf "JMAP Thread Analyzer\n";

     

       431
       431
       +
         Printf.printf "Server: %s\n" host;

     

       432
       432
       +
         Printf.printf "User: %s\n\n" user;

     

       433
       433
       +
         

     

       434
       434
       +
         (* This is where the actual JMAP calls would happen, like:

     

       435
       435
       +
         

     

       436
       436
       +
         let analyze_threads () =

     

       437
       437
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       438
       438
       +
             ~host ~username:user ~password 

     

       439
       439
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       440
       440
       +
           

     

       441
       441
       +
           (* Get primary account ID *)

     

       442
       442
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       443
       443
       +
             | Ok id -> id

     

       444
       444
       +
             | Error _ -> failwith "No mail account found"

     

       445
       445
       +
           in

     

       446
       446
       +
           

     

       447
       447
       +
           match args.thread_id with

     

       448
       448
       +
           | Some id ->

     

       449
       449
       +
               (* Analyze a specific thread by ID *)

     

       450
       450
       +
               let* thread_result = Thread.get ctx

     

       451
       451
       +
                 ~account_id

     

       452
       452
       +
                 ~ids:[id] in

     

       453
       453
       +
               

     

       454
       454
       +
               (* Handle thread fetch result *)

     

       455
       455
       +
               ...

     

       456
       456
       +
               

     

       457
       457
       +
           | None ->

     

       458
       458
       +
               (* Search for threads based on criteria *)

     

       459
       459
       +
               let filter = create_thread_filter args in

     

       460
       460
       +
               

     

       461
       461
       +
               (* Email/query to find emails matching criteria *)

     

       462
       462
       +
               let* query_result = Email.query ctx

     

       463
       463
       +
                 ~account_id

     

       464
       464
       +
                 ~filter

     

       465
       465
       +
                 ~sort:[Email_sort.received_newest_first ()]

     

       466
       466
       +
                 ~collapse_threads:true

     

       467
       467
       +
                 ~limit:args.limit in

     

       468
       468
       +
               

     

       469
       469
       +
               (* Process query results to get thread IDs *)

     

       470
       470
       +
               ...

     

       471
       471
       +
         *)

     

       472
       472
       +
         

     

       473
       473
       +
         (match thread_id with

     

       474
       474
       +
         | Some id ->

     

       475
       475
       +
             Printf.printf "Analyzing thread: %s\n\n" id;

     

       476
       476
       +
             

     

       477
       477
       +
             (* Simulate a thread with some emails *)

     

       478
       478
       +
             let emails = 5 in

     

       479
       479
       +
             Printf.printf "Thread contains %d emails\n" emails;

     

       480
       480
       +
             

     

       481
       481
       +
             (* In a real implementation, we would display the actual thread data here *)

     

       482
       482
       +
             Printf.printf "Example output format would show thread details here\n"

     

       483
       483
       +
         

     

       484
       484
       +
         | None ->

     

       485
       485
       +
             if search <> None then

     

       486
       486
       +
               Printf.printf "Searching for threads containing: %s\n" (Option.get search)

     

       487
       487
       +
             else if subject <> None then

     

       488
       488
       +
               Printf.printf "Searching for threads with subject: %s\n" (Option.get subject)

     

       489
       489
       +
             else

     

       490
       490
       +
               Printf.printf "No specific thread or search criteria provided\n");

     

       491
       491
       +
             

     

       492
       492
       +
             if participant <> [] then

     

       493
       493
       +
               Printf.printf "Filtering to threads involving: %s\n" 

     

       494
       494
       +
                 (String.concat ", " participant);

     

       495
       495
       +
             

     

       496
       496
       +
             Printf.printf "Looking at threads from the past %d days\n" days;

     

       497
       497
       +
             Printf.printf "Showing up to %d threads\n\n" limit;

     

       498
       498
       +
             

     

       499
       499
       +
             (* Simulate finding some threads *)

     

       500
       500
       +
             let thread_count = min limit 3 in

     

       501
       501
       +
             Printf.printf "Found %d matching threads\n\n" thread_count;

     

       502
       502
       +
             

     

       503
       503
       +
             (* In a real implementation, we would display the actual threads here *)

     

       504
       504
       +
             for i = 1 to thread_count do

     

       505
       505
       +
               Printf.printf "Thread %d would be displayed here\n\n" i

     

       506
       506
       +
             done;

     

       507
       507
       +
         

     

       508
       508
       +
         (* Since we're only type checking, we'll exit with success *)

     

       509
       509
       +
         0

     

       510
       510
       +
       

     

       511
       511
       +
       (* Command definition *)

     

       512
       512
       +
       let thread_cmd =

     

       513
       513
       +
         let doc = "analyze email threads using JMAP" in

     

       514
       514
       +
         let man = [

     

       515
       515
       +
           `S Manpage.s_description;

     

       516
       516
       +
           `P "Analyzes email threads with detailed visualization options.";

     

       517
       517
       +
           `P "Demonstrates how to work with JMAP's thread capabilities.";

     

       518
       518
       +
           `S Manpage.s_examples;

     

       519
       519
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -t thread123";

     

       520
       520
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --search \"project update\" --format timeline";

     

       521
       521
       +
         ] in

     

       522
       522
       +
         

     

       523
       523
       +
         let cmd =

     

       524
       524
       +
           Cmd.v

     

       525
       525
       +
             (Cmd.info "jmap-thread-analyzer" ~version:"1.0" ~doc ~man)

     

       526
       526
       +
             Term.(const thread_command $ host_arg $ user_arg $ password_arg $ 

     

       527
       527
       +
                   thread_id_arg $ search_arg $ limit_arg $ days_arg $ 

     

       528
       528
       +
                   subject_arg $ participant_arg $ format_arg $ include_body_arg)

     

       529
       529
       +
         in

     

       530
       530
       +
         cmd

     

       531
       531
       +
       

     

       532
       532
       +
       (* Main entry point *)

     

       533
       533
       +
       let () = exit (Cmd.eval' thread_cmd)

+406

bin/jmap_vacation_manager.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_vacation_manager.ml - Manage vacation/out-of-office auto-responses

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's vacation response capabilities for setting

     

       5
       5
       +
        * up and managing automatic email responses.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Vacation response actions **)

     

       13
       13
       +
       type vacation_action = 

     

       14
       14
       +
         | Show

     

       15
       15
       +
         | Enable of vacation_config

     

       16
       16
       +
         | Disable

     

       17
       17
       +
         | Update of vacation_config

     

       18
       18
       +
       

     

       19
       19
       +
       and vacation_config = {

     

       20
       20
       +
         subject : string option;

     

       21
       21
       +
         text_body : string;

     

       22
       22
       +
         html_body : string option;

     

       23
       23
       +
         from_date : float option;

     

       24
       24
       +
         to_date : float option;

     

       25
       25
       +
         exclude_addresses : string list;

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       (** Command-line arguments **)

     

       29
       29
       +
       

     

       30
       30
       +
       let host_arg =

     

       31
       31
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       32
       32
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       33
       33
       +
       

     

       34
       34
       +
       let user_arg =

     

       35
       35
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       36
       36
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       37
       37
       +
       

     

       38
       38
       +
       let password_arg =

     

       39
       39
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       40
       40
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       41
       41
       +
       

     

       42
       42
       +
       let enable_arg =

     

       43
       43
       +
         Arg.(value & flag & info ["e"; "enable"] 

     

       44
       44
       +
              ~doc:"Enable vacation response")

     

       45
       45
       +
       

     

       46
       46
       +
       let disable_arg =

     

       47
       47
       +
         Arg.(value & flag & info ["d"; "disable"] 

     

       48
       48
       +
              ~doc:"Disable vacation response")

     

       49
       49
       +
       

     

       50
       50
       +
       let show_arg =

     

       51
       51
       +
         Arg.(value & flag & info ["s"; "show"] 

     

       52
       52
       +
              ~doc:"Show current vacation settings")

     

       53
       53
       +
       

     

       54
       54
       +
       let subject_arg =

     

       55
       55
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       56
       56
       +
              ~docv:"SUBJECT" ~doc:"Vacation email subject line")

     

       57
       57
       +
       

     

       58
       58
       +
       let message_arg =

     

       59
       59
       +
         Arg.(value & opt (some string) None & info ["m"; "message"] 

     

       60
       60
       +
              ~docv:"TEXT" ~doc:"Vacation message text")

     

       61
       61
       +
       

     

       62
       62
       +
       let message_file_arg =

     

       63
       63
       +
         Arg.(value & opt (some string) None & info ["message-file"] 

     

       64
       64
       +
              ~docv:"FILE" ~doc:"Read vacation message from file")

     

       65
       65
       +
       

     

       66
       66
       +
       let html_message_arg =

     

       67
       67
       +
         Arg.(value & opt (some string) None & info ["html-message"] 

     

       68
       68
       +
              ~docv:"HTML" ~doc:"HTML vacation message")

     

       69
       69
       +
       

     

       70
       70
       +
       let from_date_arg =

     

       71
       71
       +
         Arg.(value & opt (some string) None & info ["from-date"] 

     

       72
       72
       +
              ~docv:"DATE" ~doc:"Start date for vacation (YYYY-MM-DD)")

     

       73
       73
       +
       

     

       74
       74
       +
       let to_date_arg =

     

       75
       75
       +
         Arg.(value & opt (some string) None & info ["to-date"] 

     

       76
       76
       +
              ~docv:"DATE" ~doc:"End date for vacation (YYYY-MM-DD)")

     

       77
       77
       +
       

     

       78
       78
       +
       let exclude_arg =

     

       79
       79
       +
         Arg.(value & opt_all string [] & info ["exclude"] 

     

       80
       80
       +
              ~docv:"EMAIL" ~doc:"Email address to exclude from auto-response")

     

       81
       81
       +
       

     

       82
       82
       +
       (** Helper functions **)

     

       83
       83
       +
       

     

       84
       84
       +
       (* Parse date string to Unix timestamp *)

     

       85
       85
       +
       let parse_date date_str =

     

       86
       86
       +
         try

     

       87
       87
       +
           let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in

     

       88
       88
       +
           let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       89
       89
       +
                           tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;

     

       90
       90
       +
                           tm_wday = 0; tm_yday = 0; tm_isdst = false } in

     

       91
       91
       +
           Some (Unix.mktime tm |> fst)

     

       92
       92
       +
         with _ ->

     

       93
       93
       +
           Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;

     

       94
       94
       +
           None

     

       95
       95
       +
       

     

       96
       96
       +
       (* Format Unix timestamp as date string *)

     

       97
       97
       +
       let format_date timestamp =

     

       98
       98
       +
         let tm = Unix.localtime timestamp in

     

       99
       99
       +
         Printf.sprintf "%04d-%02d-%02d"

     

       100
       100
       +
           (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       101
       101
       +
       

     

       102
       102
       +
       (* Read file contents *)

     

       103
       103
       +
       let read_file filename =

     

       104
       104
       +
         let ic = open_in filename in

     

       105
       105
       +
         let len = in_channel_length ic in

     

       106
       106
       +
         let content = really_input_string ic len in

     

       107
       107
       +
         close_in ic;

     

       108
       108
       +
         content

     

       109
       109
       +
       

     

       110
       110
       +
       (* Display vacation response settings *)

     

       111
       111
       +
       let show_vacation_response vacation =

     

       112
       112
       +
         Printf.printf "\nVacation Response Settings:\n";

     

       113
       113
       +
         Printf.printf "==========================\n\n";

     

       114
       114
       +
         

     

       115
       115
       +
         Printf.printf "Status: %s\n" 

     

       116
       116
       +
           (if Jmap_email.Vacation.Vacation_response.is_enabled vacation then "ENABLED" else "DISABLED");

     

       117
       117
       +
         

     

       118
       118
       +
         (match Jmap_email.Vacation.Vacation_response.subject vacation with

     

       119
       119
       +
         | Some subj -> Printf.printf "Subject: %s\n" subj

     

       120
       120
       +
         | None -> Printf.printf "Subject: (default)\n");

     

       121
       121
       +
         

     

       122
       122
       +
         (match Jmap_email.Vacation.Vacation_response.text_body vacation with

     

       123
       123
       +
         | Some body -> 

     

       124
       124
       +
             Printf.printf "\nMessage:\n";

     

       125
       125
       +
             Printf.printf "--------\n";

     

       126
       126
       +
             Printf.printf "%s\n" body;

     

       127
       127
       +
             Printf.printf "--------\n"

     

       128
       128
       +
         | None -> Printf.printf "\nMessage: (none set)\n");

     

       129
       129
       +
         

     

       130
       130
       +
         (match Jmap_email.Vacation.Vacation_response.from_date vacation with

     

       131
       131
       +
         | Some date -> Printf.printf "\nActive from: %s\n" (format_date date)

     

       132
       132
       +
         | None -> ());

     

       133
       133
       +
         

     

       134
       134
       +
         (match Jmap_email.Vacation.Vacation_response.to_date vacation with

     

       135
       135
       +
         | Some date -> Printf.printf "Active until: %s\n" (format_date date)

     

       136
       136
       +
         | None -> ());

     

       137
       137
       +
         

     

       138
       138
       +
         let excluded = match Jmap_email.Vacation.Vacation_response.id vacation with

     

       139
       139
       +
           | _ -> []  (* exclude_addresses not available in interface *) in

     

       140
       140
       +
         if excluded <> [] then (

     

       141
       141
       +
           Printf.printf "\nExcluded addresses:\n";

     

       142
       142
       +
           List.iter (Printf.printf "  - %s\n") excluded

     

       143
       143
       +
         )

     

       144
       144
       +
       

     

       145
       145
       +
       (* Get current vacation response *)

     

       146
       146
       +
       let get_vacation_response ctx session account_id =

     

       147
       147
       +
         let get_args = Jmap.Methods.Get_args.v

     

       148
       148
       +
           ~account_id

     

       149
       149
       +
           ~properties:["isEnabled"; "subject"; "textBody"; "htmlBody"; 

     

       150
       150
       +
                        "fromDate"; "toDate"; "excludeAddresses"]

     

       151
       151
       +
           () in

     

       152
       152
       +
           

     

       153
       153
       +
         let invocation = Jmap.Wire.Invocation.v

     

       154
       154
       +
           ~method_name:"VacationResponse/get"

     

       155
       155
       +
           ~arguments:(`Assoc []) (* Would serialize get_args *)

     

       156
       156
       +
           ~method_call_id:"get1"

     

       157
       157
       +
           () in

     

       158
       158
       +
           

     

       159
       159
       +
         let request = Jmap.Wire.Request.v

     

       160
       160
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]

     

       161
       161
       +
           ~method_calls:[invocation]

     

       162
       162
       +
           () in

     

       163
       163
       +
           

     

       164
       164
       +
         match Jmap_unix.request ctx request with

     

       165
       165
       +
         | Ok _ ->

     

       166
       166
       +
             (* Would extract from response - for now create a sample *)

     

       167
       167
       +
             Ok (Jmap_email.Vacation.Vacation_response.v

     

       168
       168
       +
               ~id:"vacation1"

     

       169
       169
       +
               ~is_enabled:false

     

       170
       170
       +
               ~subject:"Out of Office"

     

       171
       171
       +
               ~text_body:"I am currently out of the office and will respond when I return."

     

       172
       172
       +
               ())

     

       173
       173
       +
         | Error e -> Error e

     

       174
       174
       +
       

     

       175
       175
       +
       (* Update vacation response *)

     

       176
       176
       +
       let update_vacation_response ctx session account_id vacation_id updates =

     

       177
       177
       +
         let update_map = Hashtbl.create 1 in

     

       178
       178
       +
         Hashtbl.add update_map vacation_id updates;

     

       179
       179
       +
         

     

       180
       180
       +
         let set_args = Jmap.Methods.Set_args.v

     

       181
       181
       +
           ~account_id

     

       182
       182
       +
           ~update:update_map

     

       183
       183
       +
           () in

     

       184
       184
       +
           

     

       185
       185
       +
         let invocation = Jmap.Wire.Invocation.v

     

       186
       186
       +
           ~method_name:"VacationResponse/set"

     

       187
       187
       +
           ~arguments:(`Assoc []) (* Would serialize set_args *)

     

       188
       188
       +
           ~method_call_id:"set1"

     

       189
       189
       +
           () in

     

       190
       190
       +
           

     

       191
       191
       +
         let request = Jmap.Wire.Request.v

     

       192
       192
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]

     

       193
       193
       +
           ~method_calls:[invocation]

     

       194
       194
       +
           () in

     

       195
       195
       +
           

     

       196
       196
       +
         match Jmap_unix.request ctx request with

     

       197
       197
       +
         | Ok _ -> Ok ()

     

       198
       198
       +
         | Error e -> Error e

     

       199
       199
       +
       

     

       200
       200
       +
       (* Process vacation action *)

     

       201
       201
       +
       let process_vacation_action ctx session account_id action =

     

       202
       202
       +
         match action with

     

       203
       203
       +
         | Show ->

     

       204
       204
       +
             (match get_vacation_response ctx session account_id with

     

       205
       205
       +
             | Ok vacation ->

     

       206
       206
       +
                 show_vacation_response vacation;

     

       207
       207
       +
                 0

     

       208
       208
       +
             | Error e ->

     

       209
       209
       +
                 Printf.eprintf "Failed to get vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       210
       210
       +
                 1)

     

       211
       211
       +
             

     

       212
       212
       +
         | Enable config ->

     

       213
       213
       +
             Printf.printf "Enabling vacation response...\n";

     

       214
       214
       +
             

     

       215
       215
       +
             (* Build the vacation response object *)

     

       216
       216
       +
             let vacation = Jmap_email.Vacation.Vacation_response.v

     

       217
       217
       +
               ~id:"singleton"

     

       218
       218
       +
               ~is_enabled:true

     

       219
       219
       +
               ?subject:config.subject

     

       220
       220
       +
               ~text_body:config.text_body

     

       221
       221
       +
               ?html_body:config.html_body

     

       222
       222
       +
               ?from_date:config.from_date

     

       223
       223
       +
               ?to_date:config.to_date

     

       224
       224
       +
               () in

     

       225
       225
       +
               

     

       226
       226
       +
             (match update_vacation_response ctx session account_id "singleton" vacation with

     

       227
       227
       +
             | Ok () ->

     

       228
       228
       +
                 Printf.printf "\nVacation response enabled successfully!\n";

     

       229
       229
       +
                 

     

       230
       230
       +
                 (* Show what was set *)

     

       231
       231
       +
                 show_vacation_response vacation;

     

       232
       232
       +
                 0

     

       233
       233
       +
             | Error e ->

     

       234
       234
       +
                 Printf.eprintf "Failed to enable vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       235
       235
       +
                 1)

     

       236
       236
       +
             

     

       237
       237
       +
         | Disable ->

     

       238
       238
       +
             Printf.printf "Disabling vacation response...\n";

     

       239
       239
       +
             

     

       240
       240
       +
             let updates = Jmap_email.Vacation.Vacation_response.v

     

       241
       241
       +
               ~id:"singleton"

     

       242
       242
       +
               ~is_enabled:false

     

       243
       243
       +
               () in

     

       244
       244
       +
               

     

       245
       245
       +
             (match update_vacation_response ctx session account_id "singleton" updates with

     

       246
       246
       +
             | Ok () ->

     

       247
       247
       +
                 Printf.printf "Vacation response disabled successfully!\n";

     

       248
       248
       +
                 0

     

       249
       249
       +
             | Error e ->

     

       250
       250
       +
                 Printf.eprintf "Failed to disable vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       251
       251
       +
                 1)

     

       252
       252
       +
             

     

       253
       253
       +
         | Update config ->

     

       254
       254
       +
             Printf.printf "Updating vacation response...\n";

     

       255
       255
       +
             

     

       256
       256
       +
             (* Only update specified fields *)

     

       257
       257
       +
             let vacation = Jmap_email.Vacation.Vacation_response.v

     

       258
       258
       +
               ~id:"singleton"

     

       259
       259
       +
               ?subject:config.subject

     

       260
       260
       +
               ~text_body:config.text_body

     

       261
       261
       +
               ?html_body:config.html_body

     

       262
       262
       +
               ?from_date:config.from_date

     

       263
       263
       +
               ?to_date:config.to_date

     

       264
       264
       +
               () in

     

       265
       265
       +
               

     

       266
       266
       +
             (match update_vacation_response ctx session account_id "singleton" vacation with

     

       267
       267
       +
             | Ok () ->

     

       268
       268
       +
                 Printf.printf "Vacation response updated successfully!\n";

     

       269
       269
       +
                 

     

       270
       270
       +
                 (* Show current settings *)

     

       271
       271
       +
                 (match get_vacation_response ctx session account_id with

     

       272
       272
       +
                 | Ok current -> show_vacation_response current

     

       273
       273
       +
                 | Error _ -> ());

     

       274
       274
       +
                 0

     

       275
       275
       +
             | Error e ->

     

       276
       276
       +
                 Printf.eprintf "Failed to update vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       277
       277
       +
                 1)

     

       278
       278
       +
       

     

       279
       279
       +
       (* Command implementation *)

     

       280
       280
       +
       let vacation_command host user password enable disable show subject message 

     

       281
       281
       +
                            message_file html_message from_date to_date exclude : int =

     

       282
       282
       +
         Printf.printf "JMAP Vacation Manager\n";

     

       283
       283
       +
         Printf.printf "Server: %s\n" host;

     

       284
       284
       +
         Printf.printf "User: %s\n\n" user;

     

       285
       285
       +
         

     

       286
       286
       +
         (* Determine action *)

     

       287
       287
       +
         let action_count = (if enable then 1 else 0) + 

     

       288
       288
       +
                            (if disable then 1 else 0) + 

     

       289
       289
       +
                            (if show then 1 else 0) in

     

       290
       290
       +
                            

     

       291
       291
       +
         if action_count = 0 then (

     

       292
       292
       +
           Printf.eprintf "Error: Must specify an action: --enable, --disable, or --show\n";

     

       293
       293
       +
           exit 1

     

       294
       294
       +
         );

     

       295
       295
       +
         

     

       296
       296
       +
         if action_count > 1 then (

     

       297
       297
       +
           Printf.eprintf "Error: Can only specify one action at a time\n";

     

       298
       298
       +
           exit 1

     

       299
       299
       +
         );

     

       300
       300
       +
         

     

       301
       301
       +
         (* Build vacation config if enabling or updating *)

     

       302
       302
       +
         let config = if enable || (not disable && not show) then

     

       303
       303
       +
           (* Read message content *)

     

       304
       304
       +
           let text_body = match message, message_file with

     

       305
       305
       +
             | Some text, _ -> text

     

       306
       306
       +
             | None, Some file -> read_file file

     

       307
       307
       +
             | None, None ->

     

       308
       308
       +
                 if enable then (

     

       309
       309
       +
                   Printf.eprintf "Error: Must provide vacation message (--message or --message-file)\n";

     

       310
       310
       +
                   exit 1

     

       311
       311
       +
                 ) else ""

     

       312
       312
       +
           in

     

       313
       313
       +
           

     

       314
       314
       +
           (* Parse dates *)

     

       315
       315
       +
           let from_date = match from_date with

     

       316
       316
       +
             | Some date_str -> parse_date date_str

     

       317
       317
       +
             | None -> None

     

       318
       318
       +
           in

     

       319
       319
       +
           

     

       320
       320
       +
           let to_date = match to_date with

     

       321
       321
       +
             | Some date_str -> parse_date date_str

     

       322
       322
       +
             | None -> None

     

       323
       323
       +
           in

     

       324
       324
       +
           

     

       325
       325
       +
           Some {

     

       326
       326
       +
             subject;

     

       327
       327
       +
             text_body;

     

       328
       328
       +
             html_body = html_message;

     

       329
       329
       +
             from_date;

     

       330
       330
       +
             to_date;

     

       331
       331
       +
             exclude_addresses = exclude;

     

       332
       332
       +
           }

     

       333
       333
       +
         else

     

       334
       334
       +
           None

     

       335
       335
       +
         in

     

       336
       336
       +
         

     

       337
       337
       +
         (* Determine action *)

     

       338
       338
       +
         let action = 

     

       339
       339
       +
           if show then Show

     

       340
       340
       +
           else if disable then Disable

     

       341
       341
       +
           else if enable then Enable (Option.get config)

     

       342
       342
       +
           else Update (Option.get config)

     

       343
       343
       +
         in

     

       344
       344
       +
         

     

       345
       345
       +
         (* Connect to server *)

     

       346
       346
       +
         let ctx = Jmap_unix.create_client () in

     

       347
       347
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       348
       348
       +
         

     

       349
       349
       +
         let (ctx, session) = match result with

     

       350
       350
       +
           | Ok (ctx, session) -> (ctx, session)

     

       351
       351
       +
           | Error e -> 

     

       352
       352
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       353
       353
       +
               exit 1

     

       354
       354
       +
         in

     

       355
       355
       +
         

     

       356
       356
       +
         (* Check vacation capability *)

     

       357
       357
       +
         (* Note: has_capability not available in interface, assuming server supports it *)

     

       358
       358
       +
         

     

       359
       359
       +
         (* Get the primary account ID *)

     

       360
       360
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       361
       361
       +
           | Ok id -> id

     

       362
       362
       +
           | Error e -> 

     

       363
       363
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       364
       364
       +
               exit 1

     

       365
       365
       +
         in

     

       366
       366
       +
         

     

       367
       367
       +
         (* Process the action *)

     

       368
       368
       +
         process_vacation_action ctx session account_id action

     

       369
       369
       +
       

     

       370
       370
       +
       (* Command definition *)

     

       371
       371
       +
       let vacation_cmd =

     

       372
       372
       +
         let doc = "manage vacation/out-of-office auto-responses" in

     

       373
       373
       +
         let man = [

     

       374
       374
       +
           `S Manpage.s_description;

     

       375
       375
       +
           `P "Manage vacation responses (out-of-office auto-replies) via JMAP.";

     

       376
       376
       +
           `P "Configure automatic email responses for when you're away.";

     

       377
       377
       +
           `S Manpage.s_examples;

     

       378
       378
       +
           `P "Show current vacation settings:";

     

       379
       379
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --show";

     

       380
       380
       +
           `P "";

     

       381
       381
       +
           `P "Enable vacation response:";

     

       382
       382
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";

     

       383
       383
       +
           `P "    --subject \"Out of Office\" \\";

     

       384
       384
       +
           `P "    --message \"I am currently out of the office and will return on Monday.\"";

     

       385
       385
       +
           `P "";

     

       386
       386
       +
           `P "Enable with date range:";

     

       387
       387
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";

     

       388
       388
       +
           `P "    --message-file vacation.txt \\";

     

       389
       389
       +
           `P "    --from-date 2024-07-01 --to-date 2024-07-15";

     

       390
       390
       +
           `P "";

     

       391
       391
       +
           `P "Disable vacation response:";

     

       392
       392
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --disable";

     

       393
       393
       +
         ] in

     

       394
       394
       +
         

     

       395
       395
       +
         let cmd =

     

       396
       396
       +
           Cmd.v

     

       397
       397
       +
             (Cmd.info "jmap-vacation-manager" ~version:"1.0" ~doc ~man)

     

       398
       398
       +
             Term.(const vacation_command $ host_arg $ user_arg $ password_arg $ 

     

       399
       399
       +
                   enable_arg $ disable_arg $ show_arg $ subject_arg $ message_arg $

     

       400
       400
       +
                   message_file_arg $ html_message_arg $ from_date_arg $ to_date_arg $

     

       401
       401
       +
                   exclude_arg)

     

       402
       402
       +
         in

     

       403
       403
       +
         cmd

     

       404
       404
       +
       

     

       405
       405
       +
       (* Main entry point *)

     

       406
       406
       +
       let () = exit (Cmd.eval' vacation_cmd)

+1 -22

dune-project

···

       1
       1
       -
       (lang dune 3.17)

     

       2
       2
       -
       (name jmap)

     

       3
       3
       -
       

     

       4
       4
       -
       (source (github avsm/jmap))

     

       5
       5
       -
       (license ISC)

     

       6
       6
       -
       (authors "Anil Madhavapeddy")

     

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

     

       8
       8
       -
       

     

       9
       9
       -
       (generate_opam_files true)

     

       10
       10
       -
       

     

       11
       11
       -
       (package

     

       12
       12
       -
        (name jmap)

     

       13
       13
       -
        (synopsis "JMAP protocol")

     

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

     

       15
       15
       -
        (depends

     

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

     

       17
       17
       -
         ptime

     

       18
       18
       -
         cohttp

     

       19
       19
       -
         cohttp-lwt-unix

     

       20
       20
       -
         ezjsonm

     

       21
       21
       -
         uri

     

       22
       22
       -
         lwt))

     

       1
       1
       +
       (lang dune 3.17)

+15

jmap/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap)

     

       3
       3
       +
        (public_name jmap)

     

       4
       4
       +
        (libraries yojson uri)

     

       5
       5
       +
        (modules_without_implementation jmap jmap_binary jmap_error jmap_methods

     

       6
       6
       +
         jmap_push jmap_session jmap_types jmap_wire)

     

       7
       7
       +
        (modules

     

       8
       8
       +
         jmap

     

       9
       9
       +
         jmap_types

     

       10
       10
       +
         jmap_error

     

       11
       11
       +
         jmap_wire

     

       12
       12
       +
         jmap_session

     

       13
       13
       +
         jmap_methods

     

       14
       14
       +
         jmap_binary

     

       15
       15
       +
         jmap_push))

+136

jmap/jmap.mli

···

       1
       1
       +
       (** JMAP Core Protocol Library Interface (RFC 8620)

     

       2
       2
       +
           

     

       3
       3
       +
           This library provides OCaml types and function signatures for interacting

     

       4
       4
       +
           with a JMAP server according to the core protocol specification in RFC 8620.

     

       5
       5
       +
           

     

       6
       6
       +
           Modules:

     

       7
       7
       +
           - {!Jmap.Types}: Basic data types (Id, Date, etc.).

     

       8
       8
       +
           - {!Jmap.Error}: Error types (ProblemDetails, MethodError, SetError).

     

       9
       9
       +
           - {!Jmap.Wire}: Request and Response structures.

     

       10
       10
       +
           - {!Jmap.Session}: Session object and discovery.

     

       11
       11
       +
           - {!Jmap.Methods}: Standard method patterns (/get, /set, etc.) and Core/echo.

     

       12
       12
       +
           - {!Jmap.Binary}: Binary data upload/download types.

     

       13
       13
       +
           - {!Jmap.Push}: Push notification types (StateChange, PushSubscription).

     

       14
       14
       +
           

     

       15
       15
       +
           For email-specific extensions (RFC 8621), see the Jmap_email library.

     

       16
       16
       +
           For Unix-specific implementation, see the Jmap_unix library.

     

       17
       17
       +
           

     

       18
       18
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP

     

       19
       19
       +
       *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** {1 Core JMAP Types and Modules} *)

     

       22
       22
       +
       

     

       23
       23
       +
       module Types = Jmap_types

     

       24
       24
       +
       module Error = Jmap_error

     

       25
       25
       +
       module Wire = Jmap_wire

     

       26
       26
       +
       module Session = Jmap_session

     

       27
       27
       +
       module Methods = Jmap_methods

     

       28
       28
       +
       module Binary = Jmap_binary

     

       29
       29
       +
       module Push = Jmap_push

     

       30
       30
       +
       

     

       31
       31
       +
       (** {1 Example Usage} 

     

       32
       32
       +
       

     

       33
       33
       +
           The following example demonstrates using the Core JMAP library with the Unix implementation

     

       34
       34
       +
           to make a simple echo request.

     

       35
       35
       +
       

     

       36
       36
       +
       {[ 

     

       37
       37
       +
         (* OCaml 5.1 required for Lwt let operators *) 

     

       38
       38
       +
         open Lwt.Syntax 

     

       39
       39
       +
         open Jmap 

     

       40
       40
       +
         open Jmap.Types 

     

       41
       41
       +
         open Jmap.Wire 

     

       42
       42
       +
         open Jmap.Methods

     

       43
       43
       +
         open Jmap.Unix

     

       44
       44
       +
         

     

       45
       45
       +
         let simple_echo_request ctx session = 

     

       46
       46
       +
           (* Prepare an echo invocation *) 

     

       47
       47
       +
           let echo_args = Yojson.Safe.to_basic (`Assoc [

     

       48
       48
       +
             ("hello", `String "world");

     

       49
       49
       +
             ("array", `List [`Int 1; `Int 2; `Int 3]);

     

       50
       50
       +
           ]) in

     

       51
       51
       +
           

     

       52
       52
       +
           let echo_invocation = Invocation.v 

     

       53
       53
       +
             ~method_name:"Core/echo"

     

       54
       54
       +
             ~arguments:echo_args

     

       55
       55
       +
             ~method_call_id:"echo1"

     

       56
       56
       +
             ()

     

       57
       57
       +
           in

     

       58
       58
       +
       

     

       59
       59
       +
           (* Prepare the JMAP request *) 

     

       60
       60
       +
           let request = Request.v

     

       61
       61
       +
             ~using:[capability_core]

     

       62
       62
       +
             ~method_calls:[echo_invocation]

     

       63
       63
       +
             ()

     

       64
       64
       +
           in

     

       65
       65
       +
       

     

       66
       66
       +
           (* Send the request *) 

     

       67
       67
       +
           let* response = Jmap.Unix.request ctx request in

     

       68
       68
       +
       

     

       69
       69
       +
           (* Process the response *) 

     

       70
       70
       +
           match Wire.find_method_response response "echo1" with

     

       71
       71
       +
           | Some (method_name, args, _) when method_name = "Core/echo" ->

     

       72
       72
       +
               (* Echo response should contain the same arguments we sent *)

     

       73
       73
       +
               let hello_value = match Yojson.Safe.Util.member "hello" args with

     

       74
       74
       +
                 | `String s -> s

     

       75
       75
       +
                 | _ -> "not found"

     

       76
       76
       +
               in

     

       77
       77
       +
               Printf.printf "Echo response received: hello=%s\n" hello_value;

     

       78
       78
       +
               Lwt.return_unit

     

       79
       79
       +
           | _ ->

     

       80
       80
       +
               Printf.eprintf "Echo response not found or unexpected format\n";

     

       81
       81
       +
               Lwt.return_unit

     

       82
       82
       +
       

     

       83
       83
       +
         let main () = 

     

       84
       84
       +
           (* Authentication details are placeholder *) 

     

       85
       85
       +
           let credentials = "my_auth_token" in 

     

       86
       86
       +
           let* (ctx, session) = Jmap.Unix.connect ~host:"jmap.example.com" ~credentials in 

     

       87
       87
       +
           let* () = simple_echo_request ctx session in 

     

       88
       88
       +
           Jmap.Unix.close ctx 

     

       89
       89
       +
       

     

       90
       90
       +
         (* Lwt_main.run (main ()) *) 

     

       91
       91
       +
       ]} 

     

       92
       92
       +
       *)

     

       93
       93
       +
       

     

       94
       94
       +
       (** Capability URI for JMAP Core.

     

       95
       95
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       96
       96
       +
       val capability_core : string

     

       97
       97
       +
       

     

       98
       98
       +
       (** {1 Convenience Functions} *)

     

       99
       99
       +
       

     

       100
       100
       +
       (** Check if a session supports a given capability.

     

       101
       101
       +
           @param session The session object.

     

       102
       102
       +
           @param capability The capability URI to check.

     

       103
       103
       +
           @return True if supported, false otherwise.

     

       104
       104
       +
       *)

     

       105
       105
       +
       val supports_capability : Jmap_session.Session.t -> string -> bool

     

       106
       106
       +
       

     

       107
       107
       +
       (** Get the primary account ID for a given capability.

     

       108
       108
       +
           @param session The session object.

     

       109
       109
       +
           @param capability The capability URI.

     

       110
       110
       +
           @return The account ID or an error if not found.

     

       111
       111
       +
       *)

     

       112
       112
       +
       val get_primary_account : Jmap_session.Session.t -> string -> (Jmap_types.id, Error.error) result

     

       113
       113
       +
       

     

       114
       114
       +
       (** Get the download URL for a blob.

     

       115
       115
       +
           @param session The session object.

     

       116
       116
       +
           @param account_id The account ID.

     

       117
       117
       +
           @param blob_id The blob ID.

     

       118
       118
       +
           @param ?name Optional filename for the download.

     

       119
       119
       +
           @param ?content_type Optional content type for the download.

     

       120
       120
       +
           @return The download URL.

     

       121
       121
       +
       *)

     

       122
       122
       +
       val get_download_url : 

     

       123
       123
       +
         Jmap_session.Session.t -> 

     

       124
       124
       +
         account_id:Jmap_types.id -> 

     

       125
       125
       +
         blob_id:Jmap_types.id -> 

     

       126
       126
       +
         ?name:string -> 

     

       127
       127
       +
         ?content_type:string -> 

     

       128
       128
       +
         unit ->

     

       129
       129
       +
         Uri.t

     

       130
       130
       +
       

     

       131
       131
       +
       (** Get the upload URL for a blob.

     

       132
       132
       +
           @param session The session object.

     

       133
       133
       +
           @param account_id The account ID.

     

       134
       134
       +
           @return The upload URL.

     

       135
       135
       +
       *)

     

       136
       136
       +
       val get_upload_url : Jmap_session.Session.t -> account_id:Jmap_types.id -> Uri.t

+60

jmap/jmap_binary.mli

···

       1
       1
       +
       (** JMAP Binary Data Handling.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       open Jmap_error

     

       6
       6
       +
       

     

       7
       7
       +
       (** Response from uploading binary data.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)

     

       9
       9
       +
       module Upload_response : sig

     

       10
       10
       +
         type t

     

       11
       11
       +
         

     

       12
       12
       +
         val account_id : t -> id

     

       13
       13
       +
         val blob_id : t -> id

     

       14
       14
       +
         val type_ : t -> string

     

       15
       15
       +
         val size : t -> uint

     

       16
       16
       +
         

     

       17
       17
       +
         val v :

     

       18
       18
       +
           account_id:id ->

     

       19
       19
       +
           blob_id:id ->

     

       20
       20
       +
           type_:string ->

     

       21
       21
       +
           size:uint ->

     

       22
       22
       +
           unit ->

     

       23
       23
       +
           t

     

       24
       24
       +
       end

     

       25
       25
       +
       

     

       26
       26
       +
       (** Arguments for Blob/copy.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)

     

       28
       28
       +
       module Blob_copy_args : sig

     

       29
       29
       +
         type t

     

       30
       30
       +
         

     

       31
       31
       +
         val from_account_id : t -> id

     

       32
       32
       +
         val account_id : t -> id

     

       33
       33
       +
         val blob_ids : t -> id list

     

       34
       34
       +
         

     

       35
       35
       +
         val v :

     

       36
       36
       +
           from_account_id:id ->

     

       37
       37
       +
           account_id:id ->

     

       38
       38
       +
           blob_ids:id list ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** Response for Blob/copy.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)

     

       45
       45
       +
       module Blob_copy_response : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         val from_account_id : t -> id

     

       49
       49
       +
         val account_id : t -> id

     

       50
       50
       +
         val copied : t -> id id_map option

     

       51
       51
       +
         val not_copied : t -> Set_error.t id_map option

     

       52
       52
       +
         

     

       53
       53
       +
         val v :

     

       54
       54
       +
           from_account_id:id ->

     

       55
       55
       +
           account_id:id ->

     

       56
       56
       +
           ?copied:id id_map ->

     

       57
       57
       +
           ?not_copied:Set_error.t id_map ->

     

       58
       58
       +
           unit ->

     

       59
       59
       +
           t

     

       60
       60
       +
       end

+189

jmap/jmap_error.mli

···

       1
       1
       +
       (** JMAP Error Types.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       

     

       6
       6
       +
       (** Standard Method-level error types.

     

       7
       7
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       8
       8
       +
       type method_error_type = [

     

       9
       9
       +
         | `ServerUnavailable

     

       10
       10
       +
         | `ServerFail

     

       11
       11
       +
         | `ServerPartialFail

     

       12
       12
       +
         | `UnknownMethod

     

       13
       13
       +
         | `InvalidArguments

     

       14
       14
       +
         | `InvalidResultReference

     

       15
       15
       +
         | `Forbidden

     

       16
       16
       +
         | `AccountNotFound

     

       17
       17
       +
         | `AccountNotSupportedByMethod

     

       18
       18
       +
         | `AccountReadOnly

     

       19
       19
       +
         | `RequestTooLarge

     

       20
       20
       +
         | `CannotCalculateChanges

     

       21
       21
       +
         | `StateMismatch

     

       22
       22
       +
         | `AnchorNotFound

     

       23
       23
       +
         | `UnsupportedSort

     

       24
       24
       +
         | `UnsupportedFilter

     

       25
       25
       +
         | `TooManyChanges

     

       26
       26
       +
         | `FromAccountNotFound

     

       27
       27
       +
         | `FromAccountNotSupportedByMethod

     

       28
       28
       +
         | `Other_method_error of string

     

       29
       29
       +
       ]

     

       30
       30
       +
       

     

       31
       31
       +
       (** Standard SetError types.

     

       32
       32
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       33
       33
       +
       type set_error_type = [

     

       34
       34
       +
         | `Forbidden

     

       35
       35
       +
         | `OverQuota

     

       36
       36
       +
         | `TooLarge

     

       37
       37
       +
         | `RateLimit

     

       38
       38
       +
         | `NotFound

     

       39
       39
       +
         | `InvalidPatch

     

       40
       40
       +
         | `WillDestroy

     

       41
       41
       +
         | `InvalidProperties

     

       42
       42
       +
         | `Singleton

     

       43
       43
       +
         | `AlreadyExists (* From /copy *)

     

       44
       44
       +
         | `MailboxHasChild (* RFC 8621 *)

     

       45
       45
       +
         | `MailboxHasEmail (* RFC 8621 *)

     

       46
       46
       +
         | `BlobNotFound (* RFC 8621 *)

     

       47
       47
       +
         | `TooManyKeywords (* RFC 8621 *)

     

       48
       48
       +
         | `TooManyMailboxes (* RFC 8621 *)

     

       49
       49
       +
         | `InvalidEmail (* RFC 8621 *)

     

       50
       50
       +
         | `TooManyRecipients (* RFC 8621 *)

     

       51
       51
       +
         | `NoRecipients (* RFC 8621 *)

     

       52
       52
       +
         | `InvalidRecipients (* RFC 8621 *)

     

       53
       53
       +
         | `ForbiddenMailFrom (* RFC 8621 *)

     

       54
       54
       +
         | `ForbiddenFrom (* RFC 8621 *)

     

       55
       55
       +
         | `ForbiddenToSend (* RFC 8621 *)

     

       56
       56
       +
         | `CannotUnsend (* RFC 8621 *)

     

       57
       57
       +
         | `Other_set_error of string (* For future or custom errors *)

     

       58
       58
       +
       ]

     

       59
       59
       +
       

     

       60
       60
       +
       (** Primary error type that can represent all JMAP errors *)

     

       61
       61
       +
       type error =

     

       62
       62
       +
         | Transport of string     (** Network/HTTP-level error *)

     

       63
       63
       +
         | Parse of string         (** JSON parsing error *)

     

       64
       64
       +
         | Protocol of string      (** JMAP protocol error *)

     

       65
       65
       +
         | Problem of string       (** Problem Details object error *)

     

       66
       66
       +
         | Method of method_error_type * string option (** Method error with optional description *)

     

       67
       67
       +
         | SetItem of id * set_error_type * string option (** Error for a specific item in a /set operation *)

     

       68
       68
       +
         | Auth of string          (** Authentication error *)

     

       69
       69
       +
         | ServerError of string   (** Server reported an error *)

     

       70
       70
       +
       

     

       71
       71
       +
       (** Standard Result type for JMAP operations *)

     

       72
       72
       +
       type 'a result = ('a, error) Result.t

     

       73
       73
       +
       

     

       74
       74
       +
       (** Problem details object for HTTP-level errors.

     

       75
       75
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.1> RFC 8620, Section 3.6.1

     

       76
       76
       +
           @see <https://www.rfc-editor.org/rfc/rfc7807.html> RFC 7807 *)

     

       77
       77
       +
       module Problem_details : sig

     

       78
       78
       +
         type t

     

       79
       79
       +
       

     

       80
       80
       +
         val problem_type : t -> string

     

       81
       81
       +
         val status : t -> int option

     

       82
       82
       +
         val detail : t -> string option

     

       83
       83
       +
         val limit : t -> string option

     

       84
       84
       +
         val other_fields : t -> Yojson.Safe.t string_map

     

       85
       85
       +
         

     

       86
       86
       +
         val v : 

     

       87
       87
       +
           ?status:int ->

     

       88
       88
       +
           ?detail:string ->

     

       89
       89
       +
           ?limit:string ->

     

       90
       90
       +
           ?other_fields:Yojson.Safe.t string_map ->

     

       91
       91
       +
           string ->

     

       92
       92
       +
           t

     

       93
       93
       +
       end

     

       94
       94
       +
       

     

       95
       95
       +
       (** Description for method errors. May contain additional details.

     

       96
       96
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       97
       97
       +
       module Method_error_description : sig

     

       98
       98
       +
         type t

     

       99
       99
       +
         

     

       100
       100
       +
         val description : t -> string option

     

       101
       101
       +
         

     

       102
       102
       +
         val v : ?description:string -> unit -> t

     

       103
       103
       +
       end

     

       104
       104
       +
       

     

       105
       105
       +
       (** Represents a method-level error response invocation part.

     

       106
       106
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       107
       107
       +
       module Method_error : sig

     

       108
       108
       +
         type t

     

       109
       109
       +
         

     

       110
       110
       +
         val type_ : t -> method_error_type

     

       111
       111
       +
         val description : t -> Method_error_description.t option

     

       112
       112
       +
         

     

       113
       113
       +
         val v : 

     

       114
       114
       +
           ?description:Method_error_description.t ->

     

       115
       115
       +
           method_error_type ->

     

       116
       116
       +
           t

     

       117
       117
       +
       end

     

       118
       118
       +
       

     

       119
       119
       +
       (** SetError object.

     

       120
       120
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       121
       121
       +
       module Set_error : sig

     

       122
       122
       +
         type t

     

       123
       123
       +
         

     

       124
       124
       +
         val type_ : t -> set_error_type

     

       125
       125
       +
         val description : t -> string option

     

       126
       126
       +
         val properties : t -> string list option

     

       127
       127
       +
         val existing_id : t -> id option

     

       128
       128
       +
         val max_recipients : t -> uint option

     

       129
       129
       +
         val invalid_recipients : t -> string list option

     

       130
       130
       +
         val max_size : t -> uint option

     

       131
       131
       +
         val not_found_blob_ids : t -> id list option

     

       132
       132
       +
         

     

       133
       133
       +
         val v :

     

       134
       134
       +
           ?description:string ->

     

       135
       135
       +
           ?properties:string list ->

     

       136
       136
       +
           ?existing_id:id ->

     

       137
       137
       +
           ?max_recipients:uint ->

     

       138
       138
       +
           ?invalid_recipients:string list ->

     

       139
       139
       +
           ?max_size:uint ->

     

       140
       140
       +
           ?not_found_blob_ids:id list ->

     

       141
       141
       +
           set_error_type ->

     

       142
       142
       +
           t

     

       143
       143
       +
       end

     

       144
       144
       +
       

     

       145
       145
       +
       (** {2 Error Handling Functions} *)

     

       146
       146
       +
       

     

       147
       147
       +
       (** Create a transport error *)

     

       148
       148
       +
       val transport_error : string -> error

     

       149
       149
       +
       

     

       150
       150
       +
       (** Create a parse error *)

     

       151
       151
       +
       val parse_error : string -> error

     

       152
       152
       +
       

     

       153
       153
       +
       (** Create a protocol error *)

     

       154
       154
       +
       val protocol_error : string -> error 

     

       155
       155
       +
       

     

       156
       156
       +
       (** Create a problem details error *)

     

       157
       157
       +
       val problem_error : Problem_details.t -> error

     

       158
       158
       +
       

     

       159
       159
       +
       (** Create a method error *)

     

       160
       160
       +
       val method_error : ?description:string -> method_error_type -> error

     

       161
       161
       +
       

     

       162
       162
       +
       (** Create a SetItem error *)

     

       163
       163
       +
       val set_item_error : id -> ?description:string -> set_error_type -> error

     

       164
       164
       +
       

     

       165
       165
       +
       (** Create an auth error *)

     

       166
       166
       +
       val auth_error : string -> error

     

       167
       167
       +
       

     

       168
       168
       +
       (** Create a server error *)

     

       169
       169
       +
       val server_error : string -> error

     

       170
       170
       +
       

     

       171
       171
       +
       (** Convert a Method_error.t to error *)

     

       172
       172
       +
       val of_method_error : Method_error.t -> error

     

       173
       173
       +
       

     

       174
       174
       +
       (** Convert a Set_error.t to error for a specific ID *)

     

       175
       175
       +
       val of_set_error : id -> Set_error.t -> error

     

       176
       176
       +
       

     

       177
       177
       +
       (** Get a human-readable description of an error *)

     

       178
       178
       +
       val error_to_string : error -> string

     

       179
       179
       +
       

     

       180
       180
       +
       (** {2 Result Handling} *)

     

       181
       181
       +
       

     

       182
       182
       +
       (** Map an error with additional context *)

     

       183
       183
       +
       val map_error : 'a result -> (error -> error) -> 'a result

     

       184
       184
       +
       

     

       185
       185
       +
       (** Add context to an error *)

     

       186
       186
       +
       val with_context : 'a result -> string -> 'a result

     

       187
       187
       +
       

     

       188
       188
       +
       (** Convert an option to a result with an error for None *)

     

       189
       189
       +
       val of_option : 'a option -> error -> 'a result

+417

jmap/jmap_methods.mli

···

       1
       1
       +
       (** Standard JMAP Methods and Core/echo.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4

     

       3
       3
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 *)

     

       4
       4
       +
       

     

       5
       5
       +
       open Jmap_types

     

       6
       6
       +
       open Jmap_error

     

       7
       7
       +
       

     

       8
       8
       +
       (** Generic representation of a record type. Actual types defined elsewhere. *)

     

       9
       9
       +
       type generic_record

     

       10
       10
       +
       

     

       11
       11
       +
       (** Arguments for /get methods.

     

       12
       12
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)

     

       13
       13
       +
       module Get_args : sig

     

       14
       14
       +
         type 'record t

     

       15
       15
       +
         

     

       16
       16
       +
         val account_id : 'record t -> id

     

       17
       17
       +
         val ids : 'record t -> id list option

     

       18
       18
       +
         val properties : 'record t -> string list option

     

       19
       19
       +
         

     

       20
       20
       +
         val v :

     

       21
       21
       +
           account_id:id ->

     

       22
       22
       +
           ?ids:id list ->

     

       23
       23
       +
           ?properties:string list ->

     

       24
       24
       +
           unit ->

     

       25
       25
       +
           'record t

     

       26
       26
       +
       end

     

       27
       27
       +
       

     

       28
       28
       +
       (** Response for /get methods.

     

       29
       29
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)

     

       30
       30
       +
       module Get_response : sig

     

       31
       31
       +
         type 'record t

     

       32
       32
       +
         

     

       33
       33
       +
         val account_id : 'record t -> id

     

       34
       34
       +
         val state : 'record t -> string

     

       35
       35
       +
         val list : 'record t -> 'record list

     

       36
       36
       +
         val not_found : 'record t -> id list

     

       37
       37
       +
         

     

       38
       38
       +
         val v :

     

       39
       39
       +
           account_id:id ->

     

       40
       40
       +
           state:string ->

     

       41
       41
       +
           list:'record list ->

     

       42
       42
       +
           not_found:id list ->

     

       43
       43
       +
           unit ->

     

       44
       44
       +
           'record t

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (** Arguments for /changes methods.

     

       48
       48
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)

     

       49
       49
       +
       module Changes_args : sig

     

       50
       50
       +
         type t

     

       51
       51
       +
         

     

       52
       52
       +
         val account_id : t -> id

     

       53
       53
       +
         val since_state : t -> string

     

       54
       54
       +
         val max_changes : t -> uint option

     

       55
       55
       +
         

     

       56
       56
       +
         val v :

     

       57
       57
       +
           account_id:id ->

     

       58
       58
       +
           since_state:string ->

     

       59
       59
       +
           ?max_changes:uint ->

     

       60
       60
       +
           unit ->

     

       61
       61
       +
           t

     

       62
       62
       +
       end

     

       63
       63
       +
       

     

       64
       64
       +
       (** Response for /changes methods.

     

       65
       65
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)

     

       66
       66
       +
       module Changes_response : sig

     

       67
       67
       +
         type t

     

       68
       68
       +
         

     

       69
       69
       +
         val account_id : t -> id

     

       70
       70
       +
         val old_state : t -> string

     

       71
       71
       +
         val new_state : t -> string

     

       72
       72
       +
         val has_more_changes : t -> bool

     

       73
       73
       +
         val created : t -> id list

     

       74
       74
       +
         val updated : t -> id list

     

       75
       75
       +
         val destroyed : t -> id list

     

       76
       76
       +
         val updated_properties : t -> string list option

     

       77
       77
       +
         

     

       78
       78
       +
         val v :

     

       79
       79
       +
           account_id:id ->

     

       80
       80
       +
           old_state:string ->

     

       81
       81
       +
           new_state:string ->

     

       82
       82
       +
           has_more_changes:bool ->

     

       83
       83
       +
           created:id list ->

     

       84
       84
       +
           updated:id list ->

     

       85
       85
       +
           destroyed:id list ->

     

       86
       86
       +
           ?updated_properties:string list ->

     

       87
       87
       +
           unit ->

     

       88
       88
       +
           t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** Patch object for /set update.

     

       92
       92
       +
           A list of (JSON Pointer path, value) pairs.

     

       93
       93
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       94
       94
       +
       type patch_object = (json_pointer * Yojson.Safe.t) list

     

       95
       95
       +
       

     

       96
       96
       +
       (** Arguments for /set methods.

     

       97
       97
       +
           ['create_record] is the record type without server-set/immutable fields.

     

       98
       98
       +
           ['update_record] is the patch object type (usually [patch_object]).

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       100
       100
       +
       module Set_args : sig

     

       101
       101
       +
         type ('create_record, 'update_record) t

     

       102
       102
       +
         

     

       103
       103
       +
         val account_id : ('a, 'b) t -> id

     

       104
       104
       +
         val if_in_state : ('a, 'b) t -> string option

     

       105
       105
       +
         val create : ('a, 'b) t -> 'a id_map option

     

       106
       106
       +
         val update : ('a, 'b) t -> 'b id_map option

     

       107
       107
       +
         val destroy : ('a, 'b) t -> id list option

     

       108
       108
       +
         val on_success_destroy_original : ('a, 'b) t -> bool option

     

       109
       109
       +
         val destroy_from_if_in_state : ('a, 'b) t -> string option

     

       110
       110
       +
         val on_destroy_remove_emails : ('a, 'b) t -> bool option

     

       111
       111
       +
         

     

       112
       112
       +
         val v :

     

       113
       113
       +
           account_id:id ->

     

       114
       114
       +
           ?if_in_state:string ->

     

       115
       115
       +
           ?create:'a id_map ->

     

       116
       116
       +
           ?update:'b id_map ->

     

       117
       117
       +
           ?destroy:id list ->

     

       118
       118
       +
           ?on_success_destroy_original:bool ->

     

       119
       119
       +
           ?destroy_from_if_in_state:string ->

     

       120
       120
       +
           ?on_destroy_remove_emails:bool ->

     

       121
       121
       +
           unit ->

     

       122
       122
       +
           ('a, 'b) t

     

       123
       123
       +
       end

     

       124
       124
       +
       

     

       125
       125
       +
       (** Response for /set methods.

     

       126
       126
       +
           ['created_record_info] is the server-set info for created records.

     

       127
       127
       +
           ['updated_record_info] is the server-set/computed info for updated records.

     

       128
       128
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       129
       129
       +
       module Set_response : sig

     

       130
       130
       +
         type ('created_record_info, 'updated_record_info) t

     

       131
       131
       +
         

     

       132
       132
       +
         val account_id : ('a, 'b) t -> id

     

       133
       133
       +
         val old_state : ('a, 'b) t -> string option

     

       134
       134
       +
         val new_state : ('a, 'b) t -> string

     

       135
       135
       +
         val created : ('a, 'b) t -> 'a id_map option

     

       136
       136
       +
         val updated : ('a, 'b) t -> 'b option id_map option

     

       137
       137
       +
         val destroyed : ('a, 'b) t -> id list option

     

       138
       138
       +
         val not_created : ('a, 'b) t -> Set_error.t id_map option

     

       139
       139
       +
         val not_updated : ('a, 'b) t -> Set_error.t id_map option

     

       140
       140
       +
         val not_destroyed : ('a, 'b) t -> Set_error.t id_map option

     

       141
       141
       +
         

     

       142
       142
       +
         val v :

     

       143
       143
       +
           account_id:id ->

     

       144
       144
       +
           ?old_state:string ->

     

       145
       145
       +
           new_state:string ->

     

       146
       146
       +
           ?created:'a id_map ->

     

       147
       147
       +
           ?updated:'b option id_map ->

     

       148
       148
       +
           ?destroyed:id list ->

     

       149
       149
       +
           ?not_created:Set_error.t id_map ->

     

       150
       150
       +
           ?not_updated:Set_error.t id_map ->

     

       151
       151
       +
           ?not_destroyed:Set_error.t id_map ->

     

       152
       152
       +
           unit ->

     

       153
       153
       +
           ('a, 'b) t

     

       154
       154
       +
       end

     

       155
       155
       +
       

     

       156
       156
       +
       (** Arguments for /copy methods.

     

       157
       157
       +
           ['copy_record_override] contains the record id and override properties.

     

       158
       158
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)

     

       159
       159
       +
       module Copy_args : sig

     

       160
       160
       +
         type 'copy_record_override t

     

       161
       161
       +
         

     

       162
       162
       +
         val from_account_id : 'a t -> id

     

       163
       163
       +
         val if_from_in_state : 'a t -> string option

     

       164
       164
       +
         val account_id : 'a t -> id

     

       165
       165
       +
         val if_in_state : 'a t -> string option

     

       166
       166
       +
         val create : 'a t -> 'a id_map

     

       167
       167
       +
         val on_success_destroy_original : 'a t -> bool

     

       168
       168
       +
         val destroy_from_if_in_state : 'a t -> string option

     

       169
       169
       +
         

     

       170
       170
       +
         val v :

     

       171
       171
       +
           from_account_id:id ->

     

       172
       172
       +
           ?if_from_in_state:string ->

     

       173
       173
       +
           account_id:id ->

     

       174
       174
       +
           ?if_in_state:string ->

     

       175
       175
       +
           create:'a id_map ->

     

       176
       176
       +
           ?on_success_destroy_original:bool ->

     

       177
       177
       +
           ?destroy_from_if_in_state:string ->

     

       178
       178
       +
           unit ->

     

       179
       179
       +
           'a t

     

       180
       180
       +
       end

     

       181
       181
       +
       

     

       182
       182
       +
       (** Response for /copy methods.

     

       183
       183
       +
           ['created_record_info] is the server-set info for the created copy.

     

       184
       184
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)

     

       185
       185
       +
       module Copy_response : sig

     

       186
       186
       +
         type 'created_record_info t

     

       187
       187
       +
         

     

       188
       188
       +
         val from_account_id : 'a t -> id

     

       189
       189
       +
         val account_id : 'a t -> id

     

       190
       190
       +
         val old_state : 'a t -> string option

     

       191
       191
       +
         val new_state : 'a t -> string

     

       192
       192
       +
         val created : 'a t -> 'a id_map option

     

       193
       193
       +
         val not_created : 'a t -> Set_error.t id_map option

     

       194
       194
       +
         

     

       195
       195
       +
         val v :

     

       196
       196
       +
           from_account_id:id ->

     

       197
       197
       +
           account_id:id ->

     

       198
       198
       +
           ?old_state:string ->

     

       199
       199
       +
           new_state:string ->

     

       200
       200
       +
           ?created:'a id_map ->

     

       201
       201
       +
           ?not_created:Set_error.t id_map ->

     

       202
       202
       +
           unit ->

     

       203
       203
       +
           'a t

     

       204
       204
       +
       end

     

       205
       205
       +
       

     

       206
       206
       +
       (** Module for generic filter representation.

     

       207
       207
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       208
       208
       +
       module Filter : sig

     

       209
       209
       +
         type t

     

       210
       210
       +
         

     

       211
       211
       +
         (** Create a filter from a raw JSON condition *)

     

       212
       212
       +
         val condition : Yojson.Safe.t -> t

     

       213
       213
       +
         

     

       214
       214
       +
         (** Create a filter with a logical operator (AND, OR, NOT) *)

     

       215
       215
       +
         val operator : [ `AND | `OR | `NOT ] -> t list -> t

     

       216
       216
       +
         

     

       217
       217
       +
         (** Combine filters with AND *)

     

       218
       218
       +
         val and_ : t list -> t

     

       219
       219
       +
         

     

       220
       220
       +
         (** Combine filters with OR *)

     

       221
       221
       +
         val or_ : t list -> t

     

       222
       222
       +
         

     

       223
       223
       +
         (** Negate a filter with NOT *)

     

       224
       224
       +
         val not_ : t -> t

     

       225
       225
       +
         

     

       226
       226
       +
         (** Convert a filter to JSON *)

     

       227
       227
       +
         val to_json : t -> Yojson.Safe.t

     

       228
       228
       +
         

     

       229
       229
       +
         (** Predefined filter helpers *)

     

       230
       230
       +
         

     

       231
       231
       +
         (** Create a filter for a text property containing a string *)

     

       232
       232
       +
         val text_contains : string -> string -> t

     

       233
       233
       +
         

     

       234
       234
       +
         (** Create a filter for a property being equal to a value *)

     

       235
       235
       +
         val property_equals : string -> Yojson.Safe.t -> t

     

       236
       236
       +
         

     

       237
       237
       +
         (** Create a filter for a property being not equal to a value *)

     

       238
       238
       +
         val property_not_equals : string -> Yojson.Safe.t -> t

     

       239
       239
       +
         

     

       240
       240
       +
         (** Create a filter for a property being greater than a value *)

     

       241
       241
       +
         val property_gt : string -> Yojson.Safe.t -> t

     

       242
       242
       +
         

     

       243
       243
       +
         (** Create a filter for a property being greater than or equal to a value *)

     

       244
       244
       +
         val property_ge : string -> Yojson.Safe.t -> t

     

       245
       245
       +
         

     

       246
       246
       +
         (** Create a filter for a property being less than a value *)

     

       247
       247
       +
         val property_lt : string -> Yojson.Safe.t -> t

     

       248
       248
       +
         

     

       249
       249
       +
         (** Create a filter for a property being less than or equal to a value *)

     

       250
       250
       +
         val property_le : string -> Yojson.Safe.t -> t

     

       251
       251
       +
         

     

       252
       252
       +
         (** Create a filter for a property value being in a list *)

     

       253
       253
       +
         val property_in : string -> Yojson.Safe.t list -> t

     

       254
       254
       +
         

     

       255
       255
       +
         (** Create a filter for a property value not being in a list *)

     

       256
       256
       +
         val property_not_in : string -> Yojson.Safe.t list -> t

     

       257
       257
       +
         

     

       258
       258
       +
         (** Create a filter for a property being present (not null) *)

     

       259
       259
       +
         val property_exists : string -> t

     

       260
       260
       +
         

     

       261
       261
       +
         (** Create a filter for a string property starting with a prefix *)

     

       262
       262
       +
         val string_starts_with : string -> string -> t

     

       263
       263
       +
         

     

       264
       264
       +
         (** Create a filter for a string property ending with a suffix *)

     

       265
       265
       +
         val string_ends_with : string -> string -> t

     

       266
       266
       +
       end

     

       267
       267
       +
       

     

       268
       268
       +
       

     

       269
       269
       +
       

     

       270
       270
       +
       (** Comparator for sorting.

     

       271
       271
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       272
       272
       +
       module Comparator : sig

     

       273
       273
       +
         type t

     

       274
       274
       +
         

     

       275
       275
       +
         val property : t -> string

     

       276
       276
       +
         val is_ascending : t -> bool option

     

       277
       277
       +
         val collation : t -> string option

     

       278
       278
       +
         val keyword : t -> string option

     

       279
       279
       +
         val other_fields : t -> Yojson.Safe.t string_map

     

       280
       280
       +
         

     

       281
       281
       +
         val v :

     

       282
       282
       +
           property:string ->

     

       283
       283
       +
           ?is_ascending:bool ->

     

       284
       284
       +
           ?collation:string ->

     

       285
       285
       +
           ?keyword:string ->

     

       286
       286
       +
           ?other_fields:Yojson.Safe.t string_map ->

     

       287
       287
       +
           unit ->

     

       288
       288
       +
           t

     

       289
       289
       +
       end

     

       290
       290
       +
       

     

       291
       291
       +
       (** Arguments for /query methods.

     

       292
       292
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       293
       293
       +
       module Query_args : sig

     

       294
       294
       +
         type t

     

       295
       295
       +
         

     

       296
       296
       +
         val account_id : t -> id

     

       297
       297
       +
         val filter : t -> Filter.t option

     

       298
       298
       +
         val sort : t -> Comparator.t list option

     

       299
       299
       +
         val position : t -> jint option

     

       300
       300
       +
         val anchor : t -> id option

     

       301
       301
       +
         val anchor_offset : t -> jint option

     

       302
       302
       +
         val limit : t -> uint option

     

       303
       303
       +
         val calculate_total : t -> bool option

     

       304
       304
       +
         val collapse_threads : t -> bool option

     

       305
       305
       +
         val sort_as_tree : t -> bool option

     

       306
       306
       +
         val filter_as_tree : t -> bool option

     

       307
       307
       +
         

     

       308
       308
       +
         val v :

     

       309
       309
       +
           account_id:id ->

     

       310
       310
       +
           ?filter:Filter.t ->

     

       311
       311
       +
           ?sort:Comparator.t list ->

     

       312
       312
       +
           ?position:jint ->

     

       313
       313
       +
           ?anchor:id ->

     

       314
       314
       +
           ?anchor_offset:jint ->

     

       315
       315
       +
           ?limit:uint ->

     

       316
       316
       +
           ?calculate_total:bool ->

     

       317
       317
       +
           ?collapse_threads:bool ->

     

       318
       318
       +
           ?sort_as_tree:bool ->

     

       319
       319
       +
           ?filter_as_tree:bool ->

     

       320
       320
       +
           unit ->

     

       321
       321
       +
           t

     

       322
       322
       +
       end

     

       323
       323
       +
       

     

       324
       324
       +
       (** Response for /query methods.

     

       325
       325
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       326
       326
       +
       module Query_response : sig

     

       327
       327
       +
         type t

     

       328
       328
       +
         

     

       329
       329
       +
         val account_id : t -> id

     

       330
       330
       +
         val query_state : t -> string

     

       331
       331
       +
         val can_calculate_changes : t -> bool

     

       332
       332
       +
         val position : t -> uint

     

       333
       333
       +
         val ids : t -> id list

     

       334
       334
       +
         val total : t -> uint option

     

       335
       335
       +
         val limit : t -> uint option

     

       336
       336
       +
         

     

       337
       337
       +
         val v :

     

       338
       338
       +
           account_id:id ->

     

       339
       339
       +
           query_state:string ->

     

       340
       340
       +
           can_calculate_changes:bool ->

     

       341
       341
       +
           position:uint ->

     

       342
       342
       +
           ids:id list ->

     

       343
       343
       +
           ?total:uint ->

     

       344
       344
       +
           ?limit:uint ->

     

       345
       345
       +
           unit ->

     

       346
       346
       +
           t

     

       347
       347
       +
       end

     

       348
       348
       +
       

     

       349
       349
       +
       (** Item indicating an added record in /queryChanges.

     

       350
       350
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       351
       351
       +
       module Added_item : sig

     

       352
       352
       +
         type t

     

       353
       353
       +
         

     

       354
       354
       +
         val id : t -> id

     

       355
       355
       +
         val index : t -> uint

     

       356
       356
       +
         

     

       357
       357
       +
         val v :

     

       358
       358
       +
           id:id ->

     

       359
       359
       +
           index:uint ->

     

       360
       360
       +
           unit ->

     

       361
       361
       +
           t

     

       362
       362
       +
       end

     

       363
       363
       +
       

     

       364
       364
       +
       (** Arguments for /queryChanges methods.

     

       365
       365
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       366
       366
       +
       module Query_changes_args : sig

     

       367
       367
       +
         type t

     

       368
       368
       +
         

     

       369
       369
       +
         val account_id : t -> id

     

       370
       370
       +
         val filter : t -> Filter.t option

     

       371
       371
       +
         val sort : t -> Comparator.t list option

     

       372
       372
       +
         val since_query_state : t -> string

     

       373
       373
       +
         val max_changes : t -> uint option

     

       374
       374
       +
         val up_to_id : t -> id option

     

       375
       375
       +
         val calculate_total : t -> bool option

     

       376
       376
       +
         val collapse_threads : t -> bool option

     

       377
       377
       +
         

     

       378
       378
       +
         val v :

     

       379
       379
       +
           account_id:id ->

     

       380
       380
       +
           ?filter:Filter.t ->

     

       381
       381
       +
           ?sort:Comparator.t list ->

     

       382
       382
       +
           since_query_state:string ->

     

       383
       383
       +
           ?max_changes:uint ->

     

       384
       384
       +
           ?up_to_id:id ->

     

       385
       385
       +
           ?calculate_total:bool ->

     

       386
       386
       +
           ?collapse_threads:bool ->

     

       387
       387
       +
           unit ->

     

       388
       388
       +
           t

     

       389
       389
       +
       end

     

       390
       390
       +
       

     

       391
       391
       +
       (** Response for /queryChanges methods.

     

       392
       392
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       393
       393
       +
       module Query_changes_response : sig

     

       394
       394
       +
         type t

     

       395
       395
       +
         

     

       396
       396
       +
         val account_id : t -> id

     

       397
       397
       +
         val old_query_state : t -> string

     

       398
       398
       +
         val new_query_state : t -> string

     

       399
       399
       +
         val total : t -> uint option

     

       400
       400
       +
         val removed : t -> id list

     

       401
       401
       +
         val added : t -> Added_item.t list

     

       402
       402
       +
         

     

       403
       403
       +
         val v :

     

       404
       404
       +
           account_id:id ->

     

       405
       405
       +
           old_query_state:string ->

     

       406
       406
       +
           new_query_state:string ->

     

       407
       407
       +
           ?total:uint ->

     

       408
       408
       +
           removed:id list ->

     

       409
       409
       +
           added:Added_item.t list ->

     

       410
       410
       +
           unit ->

     

       411
       411
       +
           t

     

       412
       412
       +
       end

     

       413
       413
       +
       

     

       414
       414
       +
       (** Core/echo method: Arguments are mirrored in the response.

     

       415
       415
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 *)

     

       416
       416
       +
       type core_echo_args = Yojson.Safe.t

     

       417
       417
       +
       type core_echo_response = Yojson.Safe.t

+230

jmap/jmap_push.mli

···

       1
       1
       +
       (** JMAP Push Notifications.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       open Jmap_methods

     

       6
       6
       +
       open Jmap_error

     

       7
       7
       +
       

     

       8
       8
       +
       (** TypeState object map (TypeName -> StateString).

     

       9
       9
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)

     

       10
       10
       +
       type type_state = string string_map

     

       11
       11
       +
       

     

       12
       12
       +
       (** StateChange object.

     

       13
       13
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)

     

       14
       14
       +
       module State_change : sig

     

       15
       15
       +
         type t

     

       16
       16
       +
         

     

       17
       17
       +
         val changed : t -> type_state id_map

     

       18
       18
       +
         

     

       19
       19
       +
         val v :

     

       20
       20
       +
           changed:type_state id_map ->

     

       21
       21
       +
           unit ->

     

       22
       22
       +
           t

     

       23
       23
       +
       end

     

       24
       24
       +
       

     

       25
       25
       +
       (** PushSubscription encryption keys.

     

       26
       26
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       27
       27
       +
       module Push_encryption_keys : sig

     

       28
       28
       +
         type t

     

       29
       29
       +
         

     

       30
       30
       +
         (** P-256 ECDH public key (URL-safe base64) *)

     

       31
       31
       +
         val p256dh : t -> string

     

       32
       32
       +
         

     

       33
       33
       +
         (** Authentication secret (URL-safe base64) *)

     

       34
       34
       +
         val auth : t -> string

     

       35
       35
       +
         

     

       36
       36
       +
         val v :

     

       37
       37
       +
           p256dh:string ->

     

       38
       38
       +
           auth:string ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** PushSubscription object.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       45
       45
       +
       module Push_subscription : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         (** Id of the subscription (server-set, immutable) *)

     

       49
       49
       +
         val id : t -> id

     

       50
       50
       +
         

     

       51
       51
       +
         (** Device client id (immutable) *)

     

       52
       52
       +
         val device_client_id : t -> string

     

       53
       53
       +
         

     

       54
       54
       +
         (** Notification URL (immutable) *)

     

       55
       55
       +
         val url : t -> Uri.t

     

       56
       56
       +
         

     

       57
       57
       +
         (** Encryption keys (immutable) *)

     

       58
       58
       +
         val keys : t -> Push_encryption_keys.t option

     

       59
       59
       +
         val verification_code : t -> string option

     

       60
       60
       +
         val expires : t -> utc_date option

     

       61
       61
       +
         val types : t -> string list option

     

       62
       62
       +
         

     

       63
       63
       +
         val v :

     

       64
       64
       +
           id:id ->

     

       65
       65
       +
           device_client_id:string ->

     

       66
       66
       +
           url:Uri.t ->

     

       67
       67
       +
           ?keys:Push_encryption_keys.t ->

     

       68
       68
       +
           ?verification_code:string ->

     

       69
       69
       +
           ?expires:utc_date ->

     

       70
       70
       +
           ?types:string list ->

     

       71
       71
       +
           unit ->

     

       72
       72
       +
           t

     

       73
       73
       +
       end

     

       74
       74
       +
       

     

       75
       75
       +
       (** PushSubscription object for creation (omits server-set fields).

     

       76
       76
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       77
       77
       +
       module Push_subscription_create : sig

     

       78
       78
       +
         type t

     

       79
       79
       +
         

     

       80
       80
       +
         val device_client_id : t -> string

     

       81
       81
       +
         val url : t -> Uri.t

     

       82
       82
       +
         val keys : t -> Push_encryption_keys.t option

     

       83
       83
       +
         val expires : t -> utc_date option

     

       84
       84
       +
         val types : t -> string list option

     

       85
       85
       +
         

     

       86
       86
       +
         val v :

     

       87
       87
       +
           device_client_id:string ->

     

       88
       88
       +
           url:Uri.t ->

     

       89
       89
       +
           ?keys:Push_encryption_keys.t ->

     

       90
       90
       +
           ?expires:utc_date ->

     

       91
       91
       +
           ?types:string list ->

     

       92
       92
       +
           unit ->

     

       93
       93
       +
           t

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (** PushSubscription object for update patch.

     

       97
       97
       +
           Only verification_code and expires can be updated.

     

       98
       98
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       100
       100
       +
       type push_subscription_update = patch_object

     

       101
       101
       +
       

     

       102
       102
       +
       (** Arguments for PushSubscription/get.

     

       103
       103
       +
           Extends standard /get args.

     

       104
       104
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)

     

       105
       105
       +
       module Push_subscription_get_args : sig

     

       106
       106
       +
         type t

     

       107
       107
       +
         

     

       108
       108
       +
         val ids : t -> id list option

     

       109
       109
       +
         val properties : t -> string list option

     

       110
       110
       +
         

     

       111
       111
       +
         val v :

     

       112
       112
       +
           ?ids:id list ->

     

       113
       113
       +
           ?properties:string list ->

     

       114
       114
       +
           unit ->

     

       115
       115
       +
           t

     

       116
       116
       +
       end

     

       117
       117
       +
       

     

       118
       118
       +
       (** Response for PushSubscription/get.

     

       119
       119
       +
           Extends standard /get response.

     

       120
       120
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)

     

       121
       121
       +
       module Push_subscription_get_response : sig

     

       122
       122
       +
         type t

     

       123
       123
       +
         

     

       124
       124
       +
         val list : t -> Push_subscription.t list

     

       125
       125
       +
         val not_found : t -> id list

     

       126
       126
       +
         

     

       127
       127
       +
         val v :

     

       128
       128
       +
           list:Push_subscription.t list ->

     

       129
       129
       +
           not_found:id list ->

     

       130
       130
       +
           unit ->

     

       131
       131
       +
           t

     

       132
       132
       +
       end

     

       133
       133
       +
       

     

       134
       134
       +
       (** Arguments for PushSubscription/set.

     

       135
       135
       +
           Extends standard /set args.

     

       136
       136
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       137
       137
       +
       module Push_subscription_set_args : sig

     

       138
       138
       +
         type t

     

       139
       139
       +
         

     

       140
       140
       +
         val create : t -> Push_subscription_create.t id_map option

     

       141
       141
       +
         val update : t -> push_subscription_update id_map option

     

       142
       142
       +
         val destroy : t -> id list option

     

       143
       143
       +
         

     

       144
       144
       +
         val v :

     

       145
       145
       +
           ?create:Push_subscription_create.t id_map ->

     

       146
       146
       +
           ?update:push_subscription_update id_map ->

     

       147
       147
       +
           ?destroy:id list ->

     

       148
       148
       +
           unit ->

     

       149
       149
       +
           t

     

       150
       150
       +
       end

     

       151
       151
       +
       

     

       152
       152
       +
       (** Server-set information for created PushSubscription.

     

       153
       153
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       154
       154
       +
       module Push_subscription_created_info : sig

     

       155
       155
       +
         type t

     

       156
       156
       +
         

     

       157
       157
       +
         val id : t -> id

     

       158
       158
       +
         val expires : t -> utc_date option

     

       159
       159
       +
         

     

       160
       160
       +
         val v :

     

       161
       161
       +
           id:id ->

     

       162
       162
       +
           ?expires:utc_date ->

     

       163
       163
       +
           unit ->

     

       164
       164
       +
           t

     

       165
       165
       +
       end

     

       166
       166
       +
       

     

       167
       167
       +
       (** Server-set information for updated PushSubscription.

     

       168
       168
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       169
       169
       +
       module Push_subscription_updated_info : sig

     

       170
       170
       +
         type t

     

       171
       171
       +
         

     

       172
       172
       +
         val expires : t -> utc_date option

     

       173
       173
       +
         

     

       174
       174
       +
         val v :

     

       175
       175
       +
           ?expires:utc_date ->

     

       176
       176
       +
           unit ->

     

       177
       177
       +
           t

     

       178
       178
       +
       end

     

       179
       179
       +
       

     

       180
       180
       +
       (** Response for PushSubscription/set.

     

       181
       181
       +
           Extends standard /set response.

     

       182
       182
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       183
       183
       +
       module Push_subscription_set_response : sig

     

       184
       184
       +
         type t

     

       185
       185
       +
         

     

       186
       186
       +
         val created : t -> Push_subscription_created_info.t id_map option

     

       187
       187
       +
         val updated : t -> Push_subscription_updated_info.t option id_map option

     

       188
       188
       +
         val destroyed : t -> id list option

     

       189
       189
       +
         val not_created : t -> Set_error.t id_map option

     

       190
       190
       +
         val not_updated : t -> Set_error.t id_map option

     

       191
       191
       +
         val not_destroyed : t -> Set_error.t id_map option

     

       192
       192
       +
         

     

       193
       193
       +
         val v :

     

       194
       194
       +
           ?created:Push_subscription_created_info.t id_map ->

     

       195
       195
       +
           ?updated:Push_subscription_updated_info.t option id_map ->

     

       196
       196
       +
           ?destroyed:id list ->

     

       197
       197
       +
           ?not_created:Set_error.t id_map ->

     

       198
       198
       +
           ?not_updated:Set_error.t id_map ->

     

       199
       199
       +
           ?not_destroyed:Set_error.t id_map ->

     

       200
       200
       +
           unit ->

     

       201
       201
       +
           t

     

       202
       202
       +
       end

     

       203
       203
       +
       

     

       204
       204
       +
       (** PushVerification object.

     

       205
       205
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       206
       206
       +
       module Push_verification : sig

     

       207
       207
       +
         type t

     

       208
       208
       +
         

     

       209
       209
       +
         val push_subscription_id : t -> id

     

       210
       210
       +
         val verification_code : t -> string

     

       211
       211
       +
         

     

       212
       212
       +
         val v :

     

       213
       213
       +
           push_subscription_id:id ->

     

       214
       214
       +
           verification_code:string ->

     

       215
       215
       +
           unit ->

     

       216
       216
       +
           t

     

       217
       217
       +
       end

     

       218
       218
       +
       

     

       219
       219
       +
       (** Data for EventSource ping event.

     

       220
       220
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)

     

       221
       221
       +
       module Event_source_ping_data : sig

     

       222
       222
       +
         type t

     

       223
       223
       +
         

     

       224
       224
       +
         val interval : t -> uint

     

       225
       225
       +
         

     

       226
       226
       +
         val v :

     

       227
       227
       +
           interval:uint ->

     

       228
       228
       +
           unit ->

     

       229
       229
       +
           t

     

       230
       230
       +
       end

+98

jmap/jmap_session.mli

···

       1
       1
       +
       (** JMAP Session Resource.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       

     

       6
       6
       +
       (** Account capability information.

     

       7
       7
       +
           The value is capability-specific.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       9
       9
       +
       type account_capability_value = Yojson.Safe.t

     

       10
       10
       +
       

     

       11
       11
       +
       (** Server capability information.

     

       12
       12
       +
           The value is capability-specific.

     

       13
       13
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       14
       14
       +
       type server_capability_value = Yojson.Safe.t

     

       15
       15
       +
       

     

       16
       16
       +
       (** Core capability information.

     

       17
       17
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       18
       18
       +
       module Core_capability : sig

     

       19
       19
       +
         type t

     

       20
       20
       +
         

     

       21
       21
       +
         val max_size_upload : t -> uint

     

       22
       22
       +
         val max_concurrent_upload : t -> uint

     

       23
       23
       +
         val max_size_request : t -> uint

     

       24
       24
       +
         val max_concurrent_requests : t -> uint

     

       25
       25
       +
         val max_calls_in_request : t -> uint

     

       26
       26
       +
         val max_objects_in_get : t -> uint

     

       27
       27
       +
         val max_objects_in_set : t -> uint

     

       28
       28
       +
         val collation_algorithms : t -> string list

     

       29
       29
       +
         

     

       30
       30
       +
         val v :

     

       31
       31
       +
           max_size_upload:uint ->

     

       32
       32
       +
           max_concurrent_upload:uint ->

     

       33
       33
       +
           max_size_request:uint ->

     

       34
       34
       +
           max_concurrent_requests:uint ->

     

       35
       35
       +
           max_calls_in_request:uint ->

     

       36
       36
       +
           max_objects_in_get:uint ->

     

       37
       37
       +
           max_objects_in_set:uint ->

     

       38
       38
       +
           collation_algorithms:string list ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** An Account object.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       45
       45
       +
       module Account : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         val name : t -> string

     

       49
       49
       +
         val is_personal : t -> bool

     

       50
       50
       +
         val is_read_only : t -> bool

     

       51
       51
       +
         val account_capabilities : t -> account_capability_value string_map

     

       52
       52
       +
         

     

       53
       53
       +
         val v :

     

       54
       54
       +
           name:string ->

     

       55
       55
       +
           ?is_personal:bool ->

     

       56
       56
       +
           ?is_read_only:bool ->

     

       57
       57
       +
           ?account_capabilities:account_capability_value string_map ->

     

       58
       58
       +
           unit ->

     

       59
       59
       +
           t

     

       60
       60
       +
       end

     

       61
       61
       +
       

     

       62
       62
       +
       (** The Session object.

     

       63
       63
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       64
       64
       +
       module Session : sig

     

       65
       65
       +
         type t

     

       66
       66
       +
         

     

       67
       67
       +
         val capabilities : t -> server_capability_value string_map

     

       68
       68
       +
         val accounts : t -> Account.t id_map

     

       69
       69
       +
         val primary_accounts : t -> id string_map

     

       70
       70
       +
         val username : t -> string

     

       71
       71
       +
         val api_url : t -> Uri.t

     

       72
       72
       +
         val download_url : t -> Uri.t

     

       73
       73
       +
         val upload_url : t -> Uri.t

     

       74
       74
       +
         val event_source_url : t -> Uri.t

     

       75
       75
       +
         val state : t -> string

     

       76
       76
       +
         

     

       77
       77
       +
         val v :

     

       78
       78
       +
           capabilities:server_capability_value string_map ->

     

       79
       79
       +
           accounts:Account.t id_map ->

     

       80
       80
       +
           primary_accounts:id string_map ->

     

       81
       81
       +
           username:string ->

     

       82
       82
       +
           api_url:Uri.t ->

     

       83
       83
       +
           download_url:Uri.t ->

     

       84
       84
       +
           upload_url:Uri.t ->

     

       85
       85
       +
           event_source_url:Uri.t ->

     

       86
       86
       +
           state:string ->

     

       87
       87
       +
           unit ->

     

       88
       88
       +
           t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** Function to perform service autodiscovery.

     

       92
       92
       +
           Returns the session URL if found.

     

       93
       93
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)

     

       94
       94
       +
       val discover : domain:string -> Uri.t option

     

       95
       95
       +
       

     

       96
       96
       +
       (** Function to fetch the session object from a given URL.

     

       97
       97
       +
           Requires authentication handling (details TBD/outside this signature). *)

     

       98
       98
       +
       val get_session : url:Uri.t -> Session.t

+38

jmap/jmap_types.mli

···

       1
       1
       +
       (** Basic JMAP types as defined in RFC 8620. *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** The Id data type.

     

       4
       4
       +
           A string of 1 to 255 octets, using URL-safe base64 characters.

     

       5
       5
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)

     

       6
       6
       +
       type id = string

     

       7
       7
       +
       

     

       8
       8
       +
       (** The Int data type.

     

       9
       9
       +
           An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int].

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)

     

       11
       11
       +
       type jint = int

     

       12
       12
       +
       

     

       13
       13
       +
       (** The UnsignedInt data type.

     

       14
       14
       +
           An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int].

     

       15
       15
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)

     

       16
       16
       +
       type uint = int

     

       17
       17
       +
       

     

       18
       18
       +
       (** The Date data type.

     

       19
       19
       +
           A string in RFC 3339 "date-time" format.

     

       20
       20
       +
           Represented as a float using Unix time.

     

       21
       21
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)

     

       22
       22
       +
       type date = float

     

       23
       23
       +
       

     

       24
       24
       +
       (** The UTCDate data type.

     

       25
       25
       +
           A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).

     

       26
       26
       +
           Represented as a float using Unix time.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)

     

       28
       28
       +
       type utc_date = float

     

       29
       29
       +
       

     

       30
       30
       +
       (** Represents a JSON object used as a map String -> V. *)

     

       31
       31
       +
       type 'v string_map = (string, 'v) Hashtbl.t

     

       32
       32
       +
       

     

       33
       33
       +
       (** Represents a JSON object used as a map Id -> V. *)

     

       34
       34
       +
       type 'v id_map = (id, 'v) Hashtbl.t

     

       35
       35
       +
       

     

       36
       36
       +
       (** Represents a JSON Pointer path with JMAP extensions.

     

       37
       37
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)

     

       38
       38
       +
       type json_pointer = string

+80

jmap/jmap_wire.mli

···

       1
       1
       +
       (** JMAP Wire Protocol Structures (Request/Response). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       

     

       5
       5
       +
       (** An invocation tuple within a request or response.

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.2> RFC 8620, Section 3.2 *)

     

       7
       7
       +
       module Invocation : sig

     

       8
       8
       +
         type t

     

       9
       9
       +
         

     

       10
       10
       +
         val method_name : t -> string

     

       11
       11
       +
         val arguments : t -> Yojson.Safe.t

     

       12
       12
       +
         val method_call_id : t -> string

     

       13
       13
       +
         

     

       14
       14
       +
         val v : 

     

       15
       15
       +
           ?arguments:Yojson.Safe.t ->

     

       16
       16
       +
           method_name:string ->

     

       17
       17
       +
           method_call_id:string ->

     

       18
       18
       +
           unit ->

     

       19
       19
       +
           t

     

       20
       20
       +
       end

     

       21
       21
       +
       

     

       22
       22
       +
       (** Method error type with context.

     

       23
       23
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       24
       24
       +
       type method_error = Jmap_error.Method_error.t * string

     

       25
       25
       +
       

     

       26
       26
       +
       (** A response invocation part, which can be a standard response or an error.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4

     

       28
       28
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       29
       29
       +
       type response_invocation = (Invocation.t, method_error) result

     

       30
       30
       +
       

     

       31
       31
       +
       (** A reference to a previous method call's result.

     

       32
       32
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)

     

       33
       33
       +
       module Result_reference : sig

     

       34
       34
       +
         type t

     

       35
       35
       +
         

     

       36
       36
       +
         val result_of : t -> string

     

       37
       37
       +
         val name : t -> string

     

       38
       38
       +
         val path : t -> json_pointer

     

       39
       39
       +
         

     

       40
       40
       +
         val v :

     

       41
       41
       +
           result_of:string ->

     

       42
       42
       +
           name:string ->

     

       43
       43
       +
           path:json_pointer ->

     

       44
       44
       +
           unit ->

     

       45
       45
       +
           t

     

       46
       46
       +
       end

     

       47
       47
       +
       

     

       48
       48
       +
       (** The Request object.

     

       49
       49
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)

     

       50
       50
       +
       module Request : sig

     

       51
       51
       +
         type t

     

       52
       52
       +
         

     

       53
       53
       +
         val using : t -> string list

     

       54
       54
       +
         val method_calls : t -> Invocation.t list

     

       55
       55
       +
         val created_ids : t -> id id_map option

     

       56
       56
       +
         

     

       57
       57
       +
         val v :

     

       58
       58
       +
           using:string list ->

     

       59
       59
       +
           method_calls:Invocation.t list ->

     

       60
       60
       +
           ?created_ids:id id_map ->

     

       61
       61
       +
           unit ->

     

       62
       62
       +
           t

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       (** The Response object.

     

       66
       66
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 *)

     

       67
       67
       +
       module Response : sig

     

       68
       68
       +
         type t

     

       69
       69
       +
         

     

       70
       70
       +
         val method_responses : t -> response_invocation list

     

       71
       71
       +
         val created_ids : t -> id id_map option

     

       72
       72
       +
         val session_state : t -> string

     

       73
       73
       +
         

     

       74
       74
       +
         val v :

     

       75
       75
       +
           method_responses:response_invocation list ->

     

       76
       76
       +
           ?created_ids:id id_map ->

     

       77
       77
       +
           session_state:string ->

     

       78
       78
       +
           unit ->

     

       79
       79
       +
           t

     

       80
       80
       +
       end

+15

jmap-email/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap_email)

     

       3
       3
       +
        (public_name jmap-email)

     

       4
       4
       +
        (libraries jmap yojson uri)

     

       5
       5
       +
        (modules_without_implementation jmap_email jmap_email_types jmap_identity

     

       6
       6
       +
         jmap_mailbox jmap_search_snippet jmap_submission jmap_thread jmap_vacation)

     

       7
       7
       +
        (modules

     

       8
       8
       +
         jmap_email

     

       9
       9
       +
         jmap_email_types

     

       10
       10
       +
         jmap_mailbox

     

       11
       11
       +
         jmap_thread

     

       12
       12
       +
         jmap_search_snippet

     

       13
       13
       +
         jmap_identity

     

       14
       14
       +
         jmap_submission

     

       15
       15
       +
         jmap_vacation))

+503

jmap-email/jmap_email.mli

···

       1
       1
       +
       (** JMAP Mail Extension Library (RFC 8621).

     

       2
       2
       +
       

     

       3
       3
       +
           This library extends the core JMAP protocol with email-specific

     

       4
       4
       +
           functionality as defined in RFC 8621. It provides types and signatures

     

       5
       5
       +
           for interacting with JMAP Mail data types: Mailbox, Thread, Email, 

     

       6
       6
       +
           SearchSnippet, Identity, EmailSubmission, and VacationResponse.

     

       7
       7
       +
           

     

       8
       8
       +
           Requires the core Jmap library and Jmap_unix library for network operations.

     

       9
       9
       +
           

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail

     

       11
       11
       +
       *)

     

       12
       12
       +
       

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       

     

       15
       15
       +
       (** {1 Core Types} *)

     

       16
       16
       +
       module Types = Jmap_email_types

     

       17
       17
       +
       

     

       18
       18
       +
       (** {1 Mailbox} 

     

       19
       19
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       20
       20
       +
       module Mailbox = Jmap_mailbox

     

       21
       21
       +
       

     

       22
       22
       +
       (** {1 Thread}

     

       23
       23
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       24
       24
       +
       module Thread = Jmap_thread

     

       25
       25
       +
       

     

       26
       26
       +
       (** {1 Search Snippet}

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       28
       28
       +
       module SearchSnippet = Jmap_search_snippet

     

       29
       29
       +
       

     

       30
       30
       +
       (** {1 Identity}

     

       31
       31
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       32
       32
       +
       module Identity = Jmap_identity

     

       33
       33
       +
       

     

       34
       34
       +
       (** {1 Email Submission}

     

       35
       35
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       36
       36
       +
       module Submission = Jmap_submission

     

       37
       37
       +
       

     

       38
       38
       +
       (** {1 Vacation Response}

     

       39
       39
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       40
       40
       +
       module Vacation = Jmap_vacation

     

       41
       41
       +
       

     

       42
       42
       +
       (** {1 Example Usage}

     

       43
       43
       +
       

     

       44
       44
       +
           The following example demonstrates using the JMAP Email library to fetch unread emails

     

       45
       45
       +
           from a specific sender.

     

       46
       46
       +
       

     

       47
       47
       +
       {[

     

       48
       48
       +
         (* OCaml 5.1 required for Lwt let operators *)

     

       49
       49
       +
         open Lwt.Syntax

     

       50
       50
       +
         open Jmap

     

       51
       51
       +
         open Jmap.Types

     

       52
       52
       +
         open Jmap.Wire

     

       53
       53
       +
         open Jmap.Methods

     

       54
       54
       +
         open Jmap_email

     

       55
       55
       +
         open Jmap.Unix

     

       56
       56
       +
         

     

       57
       57
       +
         let list_unread_from_sender ctx session sender_email =

     

       58
       58
       +
           (* Find the primary mail account *)

     

       59
       59
       +
           let primary_mail_account_id =

     

       60
       60
       +
             Hashtbl.find session.primary_accounts capability_mail

     

       61
       61
       +
           in

     

       62
       62
       +
           (* Construct the filter *)

     

       63
       63
       +
           let filter : filter =

     

       64
       64
       +
             Filter_operator (Filter_operator.v

     

       65
       65
       +
               ~operator:`AND

     

       66
       66
       +
               ~conditions:[

     

       67
       67
       +
                 Filter_condition (Yojson.Safe.to_basic (`Assoc [

     

       68
       68
       +
                   ("from", `String sender_email);

     

       69
       69
       +
                 ]));

     

       70
       70
       +
                 Filter_condition (Yojson.Safe.to_basic (`Assoc [

     

       71
       71
       +
                   ("hasKeyword", `String keyword_seen);

     

       72
       72
       +
                   ("value", `Bool false);

     

       73
       73
       +
                 ]));

     

       74
       74
       +
               ]

     

       75
       75
       +
               ())

     

       76
       76
       +
           in

     

       77
       77
       +
           (* Prepare the Email/query invocation *)

     

       78
       78
       +
           let query_args = Query_args.v

     

       79
       79
       +
             ~account_id:primary_mail_account_id

     

       80
       80
       +
             ~filter

     

       81
       81
       +
             ~sort:[

     

       82
       82
       +
               Comparator.v

     

       83
       83
       +
                 ~property:"receivedAt"

     

       84
       84
       +
                 ~is_ascending:false

     

       85
       85
       +
                 ()

     

       86
       86
       +
             ]

     

       87
       87
       +
             ~position:0

     

       88
       88
       +
             ~limit:20 (* Get latest 20 *)

     

       89
       89
       +
             ~calculate_total:false

     

       90
       90
       +
             ~collapse_threads:false

     

       91
       91
       +
             ()

     

       92
       92
       +
           in

     

       93
       93
       +
           let query_invocation = Invocation.v

     

       94
       94
       +
             ~method_name:"Email/query"

     

       95
       95
       +
             ~arguments:(* Yojson conversion of query_args needed here *)

     

       96
       96
       +
             ~method_call_id:"q1"

     

       97
       97
       +
             ()

     

       98
       98
       +
           in

     

       99
       99
       +
       

     

       100
       100
       +
           (* Prepare the Email/get invocation using a back-reference *)

     

       101
       101
       +
           let get_args = Get_args.v

     

       102
       102
       +
             ~account_id:primary_mail_account_id

     

       103
       103
       +
             ~properties:["id"; "subject"; "receivedAt"; "from"]

     

       104
       104
       +
             ()

     

       105
       105
       +
           in

     

       106
       106
       +
           let get_invocation = Invocation.v

     

       107
       107
       +
             ~method_name:"Email/get"

     

       108
       108
       +
             ~arguments:(* Yojson conversion of get_args, with ids replaced by a ResultReference to q1 needed here *)

     

       109
       109
       +
             ~method_call_id:"g1"

     

       110
       110
       +
             ()

     

       111
       111
       +
           in

     

       112
       112
       +
       

     

       113
       113
       +
           (* Prepare the JMAP request *)

     

       114
       114
       +
           let request = Request.v

     

       115
       115
       +
             ~using:[ Jmap.capability_core; capability_mail ]

     

       116
       116
       +
             ~method_calls:[ query_invocation; get_invocation ]

     

       117
       117
       +
             ()

     

       118
       118
       +
           in

     

       119
       119
       +
       

     

       120
       120
       +
           (* Send the request *)

     

       121
       121
       +
           let* response = Jmap.Unix.request ctx request in

     

       122
       122
       +
       

     

       123
       123
       +
           (* Process the response (extract Email/get results) *)

     

       124
       124
       +
           (* ... Omitted: find the Email/get response in response.method_responses ... *)

     

       125
       125
       +
           Lwt.return_unit

     

       126
       126
       +
       ]}

     

       127
       127
       +
       *)

     

       128
       128
       +
       

     

       129
       129
       +
       (** Capability URI for JMAP Mail.

     

       130
       130
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.1> RFC 8621, Section 1.3.1 *)

     

       131
       131
       +
       val capability_mail : string

     

       132
       132
       +
       

     

       133
       133
       +
       (** Capability URI for JMAP Submission.

     

       134
       134
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.2> RFC 8621, Section 1.3.2 *)

     

       135
       135
       +
       val capability_submission : string

     

       136
       136
       +
       

     

       137
       137
       +
       (** Capability URI for JMAP Vacation Response.

     

       138
       138
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.3> RFC 8621, Section 1.3.3 *)

     

       139
       139
       +
       val capability_vacationresponse : string

     

       140
       140
       +
       

     

       141
       141
       +
       (** Type name for EmailDelivery push notifications.

     

       142
       142
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.5> RFC 8621, Section 1.5 *)

     

       143
       143
       +
       val push_event_type_email_delivery : string

     

       144
       144
       +
       

     

       145
       145
       +
       (** Keyword string constants for JMAP email flags.

     

       146
       146
       +
           Provides easy access to standardized keyword string values.

     

       147
       147
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       148
       148
       +
       module Keyword : sig

     

       149
       149
       +
         (** {1 IMAP System Flags} *)

     

       150
       150
       +
         

     

       151
       151
       +
         (** "$draft": The Email is a draft the user is composing *)

     

       152
       152
       +
         val draft : string

     

       153
       153
       +
         

     

       154
       154
       +
         (** "$seen": The Email has been read *)

     

       155
       155
       +
         val seen : string

     

       156
       156
       +
         

     

       157
       157
       +
         (** "$flagged": The Email has been flagged for urgent/special attention *)

     

       158
       158
       +
         val flagged : string

     

       159
       159
       +
         

     

       160
       160
       +
         (** "$answered": The Email has been replied to *)

     

       161
       161
       +
         val answered : string

     

       162
       162
       +
         

     

       163
       163
       +
         (** {1 Common Extension Keywords} *)

     

       164
       164
       +
         

     

       165
       165
       +
         (** "$forwarded": The Email has been forwarded *)

     

       166
       166
       +
         val forwarded : string

     

       167
       167
       +
         

     

       168
       168
       +
         (** "$phishing": The Email is likely to be phishing *)

     

       169
       169
       +
         val phishing : string

     

       170
       170
       +
         

     

       171
       171
       +
         (** "$junk": The Email is spam/junk *)

     

       172
       172
       +
         val junk : string

     

       173
       173
       +
         

     

       174
       174
       +
         (** "$notjunk": The Email is explicitly marked as not spam/junk *)

     

       175
       175
       +
         val notjunk : string

     

       176
       176
       +
         

     

       177
       177
       +
         (** {1 Apple Mail and Vendor Extensions} 

     

       178
       178
       +
             @see <https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute/> *)

     

       179
       179
       +
         

     

       180
       180
       +
         (** "$notify": Request to be notified when this email gets a reply *)

     

       181
       181
       +
         val notify : string

     

       182
       182
       +
         

     

       183
       183
       +
         (** "$muted": Email is muted (notifications disabled) *)

     

       184
       184
       +
         val muted : string

     

       185
       185
       +
         

     

       186
       186
       +
         (** "$followed": Email thread is followed for notifications *)

     

       187
       187
       +
         val followed : string

     

       188
       188
       +
         

     

       189
       189
       +
         (** "$memo": Email has a memo/note associated with it *)

     

       190
       190
       +
         val memo : string

     

       191
       191
       +
         

     

       192
       192
       +
         (** "$hasmemo": Email has a memo, annotation or note property *)

     

       193
       193
       +
         val hasmemo : string

     

       194
       194
       +
         

     

       195
       195
       +
         (** "$autosent": Email was generated or sent automatically *)

     

       196
       196
       +
         val autosent : string

     

       197
       197
       +
         

     

       198
       198
       +
         (** "$unsubscribed": User has unsubscribed from this sender *)

     

       199
       199
       +
         val unsubscribed : string

     

       200
       200
       +
         

     

       201
       201
       +
         (** "$canunsubscribe": Email contains unsubscribe information *)

     

       202
       202
       +
         val canunsubscribe : string

     

       203
       203
       +
         

     

       204
       204
       +
         (** "$imported": Email was imported from another system *)

     

       205
       205
       +
         val imported : string

     

       206
       206
       +
         

     

       207
       207
       +
         (** "$istrusted": Email is from a trusted/verified sender *)

     

       208
       208
       +
         val istrusted : string

     

       209
       209
       +
         

     

       210
       210
       +
         (** "$maskedemail": Email is to/from a masked/anonymous address *)

     

       211
       211
       +
         val maskedemail : string

     

       212
       212
       +
         

     

       213
       213
       +
         (** "$new": Email was recently delivered *)

     

       214
       214
       +
         val new_mail : string

     

       215
       215
       +
         

     

       216
       216
       +
         (** {1 Apple Mail Color Flag Bits} *)

     

       217
       217
       +
         

     

       218
       218
       +
         (** "$MailFlagBit0": First color flag bit (red) *)

     

       219
       219
       +
         val mailflagbit0 : string

     

       220
       220
       +
         

     

       221
       221
       +
         (** "$MailFlagBit1": Second color flag bit (orange) *)

     

       222
       222
       +
         val mailflagbit1 : string

     

       223
       223
       +
         

     

       224
       224
       +
         (** "$MailFlagBit2": Third color flag bit (yellow) *)

     

       225
       225
       +
         val mailflagbit2 : string

     

       226
       226
       +
         

     

       227
       227
       +
         (** {1 Color Flag Combinations} *)

     

       228
       228
       +
         

     

       229
       229
       +
         (** Get color flag bit values for a specific color 

     

       230
       230
       +
             @return A list of flags to set to create the requested color *)

     

       231
       231
       +
         val color_flags : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> string list

     

       232
       232
       +
         

     

       233
       233
       +
         (** Check if a string is a valid keyword according to the RFC

     

       234
       234
       +
             @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       235
       235
       +
         val is_valid : string -> bool

     

       236
       236
       +
       end

     

       237
       237
       +
       

     

       238
       238
       +
       (** For backward compatibility - DEPRECATED, use Keyword.draft instead *)

     

       239
       239
       +
       val keyword_draft : string

     

       240
       240
       +
       

     

       241
       241
       +
       (** For backward compatibility - DEPRECATED, use Keyword.seen instead *)

     

       242
       242
       +
       val keyword_seen : string

     

       243
       243
       +
       

     

       244
       244
       +
       (** For backward compatibility - DEPRECATED, use Keyword.flagged instead *)

     

       245
       245
       +
       val keyword_flagged : string

     

       246
       246
       +
       

     

       247
       247
       +
       (** For backward compatibility - DEPRECATED, use Keyword.answered instead *)

     

       248
       248
       +
       val keyword_answered : string

     

       249
       249
       +
       

     

       250
       250
       +
       (** For backward compatibility - DEPRECATED, use Keyword.forwarded instead *)

     

       251
       251
       +
       val keyword_forwarded : string

     

       252
       252
       +
       

     

       253
       253
       +
       (** For backward compatibility - DEPRECATED, use Keyword.phishing instead *)

     

       254
       254
       +
       val keyword_phishing : string

     

       255
       255
       +
       

     

       256
       256
       +
       (** For backward compatibility - DEPRECATED, use Keyword.junk instead *)

     

       257
       257
       +
       val keyword_junk : string

     

       258
       258
       +
       

     

       259
       259
       +
       (** For backward compatibility - DEPRECATED, use Keyword.notjunk instead *)

     

       260
       260
       +
       val keyword_notjunk : string

     

       261
       261
       +
       

     

       262
       262
       +
       (** Email keyword operations.

     

       263
       263
       +
           Functions to manipulate and update email keywords/flags. *)

     

       264
       264
       +
       module Keyword_ops : sig

     

       265
       265
       +
         (** Add a keyword/flag to an email *)

     

       266
       266
       +
         val add : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t

     

       267
       267
       +
         

     

       268
       268
       +
         (** Remove a keyword/flag from an email *)

     

       269
       269
       +
         val remove : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t

     

       270
       270
       +
         

     

       271
       271
       +
         (** {1 System Flag Operations} *)

     

       272
       272
       +
         

     

       273
       273
       +
         (** Mark an email as seen/read *)

     

       274
       274
       +
         val mark_as_seen : Types.Email.t -> Types.Email.t

     

       275
       275
       +
         

     

       276
       276
       +
         (** Mark an email as unseen/unread *)

     

       277
       277
       +
         val mark_as_unseen : Types.Email.t -> Types.Email.t

     

       278
       278
       +
         

     

       279
       279
       +
         (** Mark an email as flagged/important *)

     

       280
       280
       +
         val mark_as_flagged : Types.Email.t -> Types.Email.t

     

       281
       281
       +
         

     

       282
       282
       +
         (** Remove flagged/important marking from an email *)

     

       283
       283
       +
         val unmark_flagged : Types.Email.t -> Types.Email.t

     

       284
       284
       +
         

     

       285
       285
       +
         (** Mark an email as a draft *)

     

       286
       286
       +
         val mark_as_draft : Types.Email.t -> Types.Email.t

     

       287
       287
       +
         

     

       288
       288
       +
         (** Remove draft marking from an email *)

     

       289
       289
       +
         val unmark_draft : Types.Email.t -> Types.Email.t

     

       290
       290
       +
         

     

       291
       291
       +
         (** Mark an email as answered/replied *)

     

       292
       292
       +
         val mark_as_answered : Types.Email.t -> Types.Email.t

     

       293
       293
       +
         

     

       294
       294
       +
         (** Remove answered/replied marking from an email *)

     

       295
       295
       +
         val unmark_answered : Types.Email.t -> Types.Email.t

     

       296
       296
       +
         

     

       297
       297
       +
         (** Mark an email as forwarded *)

     

       298
       298
       +
         val mark_as_forwarded : Types.Email.t -> Types.Email.t

     

       299
       299
       +
         

     

       300
       300
       +
         (** Mark an email as spam/junk *)

     

       301
       301
       +
         val mark_as_junk : Types.Email.t -> Types.Email.t

     

       302
       302
       +
         

     

       303
       303
       +
         (** Mark an email as not spam/junk *)

     

       304
       304
       +
         val mark_as_not_junk : Types.Email.t -> Types.Email.t

     

       305
       305
       +
         

     

       306
       306
       +
         (** Mark an email as phishing *)

     

       307
       307
       +
         val mark_as_phishing : Types.Email.t -> Types.Email.t

     

       308
       308
       +
         

     

       309
       309
       +
         (** {1 Extension Flag Operations} *)

     

       310
       310
       +
         

     

       311
       311
       +
         (** Mark an email for notification when replied to *)

     

       312
       312
       +
         val mark_as_notify : Types.Email.t -> Types.Email.t

     

       313
       313
       +
         

     

       314
       314
       +
         (** Remove notification flag from an email *)

     

       315
       315
       +
         val unmark_notify : Types.Email.t -> Types.Email.t

     

       316
       316
       +
         

     

       317
       317
       +
         (** Mark an email as muted (no notifications) *)

     

       318
       318
       +
         val mark_as_muted : Types.Email.t -> Types.Email.t

     

       319
       319
       +
         

     

       320
       320
       +
         (** Unmute an email (allow notifications) *)

     

       321
       321
       +
         val unmark_muted : Types.Email.t -> Types.Email.t

     

       322
       322
       +
         

     

       323
       323
       +
         (** Mark an email thread as followed for notifications *)

     

       324
       324
       +
         val mark_as_followed : Types.Email.t -> Types.Email.t

     

       325
       325
       +
         

     

       326
       326
       +
         (** Remove followed status from an email thread *)

     

       327
       327
       +
         val unmark_followed : Types.Email.t -> Types.Email.t

     

       328
       328
       +
         

     

       329
       329
       +
         (** Mark an email with a memo *)

     

       330
       330
       +
         val mark_as_memo : Types.Email.t -> Types.Email.t

     

       331
       331
       +
         

     

       332
       332
       +
         (** Mark an email with the hasmemo flag *)

     

       333
       333
       +
         val mark_as_hasmemo : Types.Email.t -> Types.Email.t

     

       334
       334
       +
         

     

       335
       335
       +
         (** Mark an email as automatically sent *)

     

       336
       336
       +
         val mark_as_autosent : Types.Email.t -> Types.Email.t

     

       337
       337
       +
         

     

       338
       338
       +
         (** Mark an email as being from an unsubscribed sender *)

     

       339
       339
       +
         val mark_as_unsubscribed : Types.Email.t -> Types.Email.t

     

       340
       340
       +
         

     

       341
       341
       +
         (** Mark an email as having unsubscribe capability *)

     

       342
       342
       +
         val mark_as_canunsubscribe : Types.Email.t -> Types.Email.t

     

       343
       343
       +
         

     

       344
       344
       +
         (** Mark an email as imported from another system *)

     

       345
       345
       +
         val mark_as_imported : Types.Email.t -> Types.Email.t

     

       346
       346
       +
         

     

       347
       347
       +
         (** Mark an email as from a trusted/verified sender *)

     

       348
       348
       +
         val mark_as_trusted : Types.Email.t -> Types.Email.t

     

       349
       349
       +
         

     

       350
       350
       +
         (** Mark an email as having masked/anonymous address *)

     

       351
       351
       +
         val mark_as_maskedemail : Types.Email.t -> Types.Email.t

     

       352
       352
       +
         

     

       353
       353
       +
         (** Mark an email as new/recent *)

     

       354
       354
       +
         val mark_as_new : Types.Email.t -> Types.Email.t

     

       355
       355
       +
         

     

       356
       356
       +
         (** Remove new/recent flag from an email *)

     

       357
       357
       +
         val unmark_new : Types.Email.t -> Types.Email.t

     

       358
       358
       +
         

     

       359
       359
       +
         (** {1 Color Flag Operations} *)

     

       360
       360
       +
         

     

       361
       361
       +
         (** Set color flag bits on an email *)

     

       362
       362
       +
         val set_color_flags : Types.Email.t -> red:bool -> orange:bool -> yellow:bool -> Types.Email.t

     

       363
       363
       +
         

     

       364
       364
       +
         (** Mark an email with a predefined color *)

     

       365
       365
       +
         val mark_as_color : Types.Email.t -> 

     

       366
       366
       +
           [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> Types.Email.t

     

       367
       367
       +
         

     

       368
       368
       +
         (** Remove all color flag bits from an email *)

     

       369
       369
       +
         val clear_color_flags : Types.Email.t -> Types.Email.t

     

       370
       370
       +
         

     

       371
       371
       +
         (** {1 Custom Flag Operations} *)

     

       372
       372
       +
         

     

       373
       373
       +
         (** Add a custom keyword to an email *)

     

       374
       374
       +
         val add_custom : Types.Email.t -> string -> Types.Email.t

     

       375
       375
       +
         

     

       376
       376
       +
         (** Remove a custom keyword from an email *)

     

       377
       377
       +
         val remove_custom : Types.Email.t -> string -> Types.Email.t

     

       378
       378
       +
       

     

       379
       379
       +
         (** {1 Patch Object Creation} *)

     

       380
       380
       +
       

     

       381
       381
       +
         (** Create a patch object to add a keyword to emails *)

     

       382
       382
       +
         val add_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object

     

       383
       383
       +
       

     

       384
       384
       +
         (** Create a patch object to remove a keyword from emails *)

     

       385
       385
       +
         val remove_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object

     

       386
       386
       +
       

     

       387
       387
       +
         (** Create a patch object to mark emails as seen/read *)

     

       388
       388
       +
         val mark_seen_patch : unit -> Jmap.Methods.patch_object

     

       389
       389
       +
       

     

       390
       390
       +
         (** Create a patch object to mark emails as unseen/unread *)

     

       391
       391
       +
         val mark_unseen_patch : unit -> Jmap.Methods.patch_object

     

       392
       392
       +
         

     

       393
       393
       +
         (** Create a patch object to set a specific color on emails *)

     

       394
       394
       +
         val set_color_patch : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> 

     

       395
       395
       +
           Jmap.Methods.patch_object

     

       396
       396
       +
       end

     

       397
       397
       +
       

     

       398
       398
       +
       (** Conversion functions for JMAP/IMAP compatibility *)

     

       399
       399
       +
       module Conversion : sig

     

       400
       400
       +
         (** {1 Keyword/Flag Conversion} *)

     

       401
       401
       +
         

     

       402
       402
       +
         (** Convert a JMAP keyword variant to IMAP flag *)

     

       403
       403
       +
         val keyword_to_imap_flag : Types.Keywords.keyword -> string

     

       404
       404
       +
         

     

       405
       405
       +
         (** Convert an IMAP flag to JMAP keyword variant *)

     

       406
       406
       +
         val imap_flag_to_keyword : string -> Types.Keywords.keyword

     

       407
       407
       +
         

     

       408
       408
       +
         (** Check if a string is valid for use as a custom keyword according to RFC 8621.

     

       409
       409
       +
             @deprecated Use Keyword.is_valid instead. *)

     

       410
       410
       +
         val is_valid_custom_keyword : string -> bool

     

       411
       411
       +
         

     

       412
       412
       +
         (** Get the JMAP protocol string representation of a keyword *)

     

       413
       413
       +
         val keyword_to_string : Types.Keywords.keyword -> string

     

       414
       414
       +
         

     

       415
       415
       +
         (** Parse a JMAP protocol string into a keyword variant *)

     

       416
       416
       +
         val string_to_keyword : string -> Types.Keywords.keyword

     

       417
       417
       +
         

     

       418
       418
       +
         (** {1 Color Conversion} *)

     

       419
       419
       +
         

     

       420
       420
       +
         (** Convert a color name to the corresponding flag bit combination *)

     

       421
       421
       +
         val color_to_flags : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> 

     

       422
       422
       +
           Types.Keywords.keyword list

     

       423
       423
       +
           

     

       424
       424
       +
         (** Try to determine a color from a set of keywords *)

     

       425
       425
       +
         val keywords_to_color : Types.Keywords.t -> 

     

       426
       426
       +
           [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option

     

       427
       427
       +
       end

     

       428
       428
       +
       

     

       429
       429
       +
       (** {1 Helper Functions} *)

     

       430
       430
       +
       

     

       431
       431
       +
       (** Email query filter helpers *)

     

       432
       432
       +
       module Email_filter : sig

     

       433
       433
       +
         (** Create a filter to find messages in a specific mailbox *)

     

       434
       434
       +
         val in_mailbox : id -> Jmap.Methods.Filter.t

     

       435
       435
       +
         

     

       436
       436
       +
         (** Create a filter to find messages with a specific keyword/flag *)

     

       437
       437
       +
         val has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t

     

       438
       438
       +
         

     

       439
       439
       +
         (** Create a filter to find messages without a specific keyword/flag *)

     

       440
       440
       +
         val not_has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t

     

       441
       441
       +
         

     

       442
       442
       +
         (** Create a filter to find unread messages *)

     

       443
       443
       +
         val unread : unit -> Jmap.Methods.Filter.t

     

       444
       444
       +
         

     

       445
       445
       +
         (** Create a filter to find messages with a specific subject *)

     

       446
       446
       +
         val subject : string -> Jmap.Methods.Filter.t

     

       447
       447
       +
         

     

       448
       448
       +
         (** Create a filter to find messages from a specific sender *)

     

       449
       449
       +
         val from : string -> Jmap.Methods.Filter.t

     

       450
       450
       +
         

     

       451
       451
       +
         (** Create a filter to find messages sent to a specific recipient *)

     

       452
       452
       +
         val to_ : string -> Jmap.Methods.Filter.t

     

       453
       453
       +
         

     

       454
       454
       +
         (** Create a filter to find messages with attachments *)

     

       455
       455
       +
         val has_attachment : unit -> Jmap.Methods.Filter.t

     

       456
       456
       +
         

     

       457
       457
       +
         (** Create a filter to find messages received before a date *)

     

       458
       458
       +
         val before : date -> Jmap.Methods.Filter.t

     

       459
       459
       +
         

     

       460
       460
       +
         (** Create a filter to find messages received after a date *)

     

       461
       461
       +
         val after : date -> Jmap.Methods.Filter.t

     

       462
       462
       +
         

     

       463
       463
       +
         (** Create a filter to find messages with size larger than the given bytes *)

     

       464
       464
       +
         val larger_than : uint -> Jmap.Methods.Filter.t

     

       465
       465
       +
         

     

       466
       466
       +
         (** Create a filter to find messages with size smaller than the given bytes *)

     

       467
       467
       +
         val smaller_than : uint -> Jmap.Methods.Filter.t

     

       468
       468
       +
       end

     

       469
       469
       +
       

     

       470
       470
       +
       (** Common email sorting comparators *)

     

       471
       471
       +
       module Email_sort : sig

     

       472
       472
       +
         (** Sort by received date (most recent first) *)

     

       473
       473
       +
         val received_newest_first : unit -> Jmap.Methods.Comparator.t

     

       474
       474
       +
         

     

       475
       475
       +
         (** Sort by received date (oldest first) *)

     

       476
       476
       +
         val received_oldest_first : unit -> Jmap.Methods.Comparator.t

     

       477
       477
       +
         

     

       478
       478
       +
         (** Sort by sent date (most recent first) *)

     

       479
       479
       +
         val sent_newest_first : unit -> Jmap.Methods.Comparator.t

     

       480
       480
       +
         

     

       481
       481
       +
         (** Sort by sent date (oldest first) *)

     

       482
       482
       +
         val sent_oldest_first : unit -> Jmap.Methods.Comparator.t

     

       483
       483
       +
         

     

       484
       484
       +
         (** Sort by subject (A-Z) *)

     

       485
       485
       +
         val subject_asc : unit -> Jmap.Methods.Comparator.t

     

       486
       486
       +
         

     

       487
       487
       +
         (** Sort by subject (Z-A) *)

     

       488
       488
       +
         val subject_desc : unit -> Jmap.Methods.Comparator.t

     

       489
       489
       +
         

     

       490
       490
       +
         (** Sort by size (largest first) *)

     

       491
       491
       +
         val size_largest_first : unit -> Jmap.Methods.Comparator.t

     

       492
       492
       +
         

     

       493
       493
       +
         (** Sort by size (smallest first) *)

     

       494
       494
       +
         val size_smallest_first : unit -> Jmap.Methods.Comparator.t

     

       495
       495
       +
         

     

       496
       496
       +
         (** Sort by from address (A-Z) *)

     

       497
       497
       +
         val from_asc : unit -> Jmap.Methods.Comparator.t

     

       498
       498
       +
         

     

       499
       499
       +
         (** Sort by from address (Z-A) *)

     

       500
       500
       +
         val from_desc : unit -> Jmap.Methods.Comparator.t

     

       501
       501
       +
       end

     

       502
       502
       +
       

     

       503
       503
       +
       (** High-level email operations are implemented in the Jmap.Unix.Email module *)

+519

jmap-email/jmap_email_types.mli

···

       1
       1
       +
       (** Common types for JMAP Mail (RFC 8621). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       

     

       5
       5
       +
       (** Represents an email address with an optional name.

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3 *)

     

       7
       7
       +
       module Email_address : sig

     

       8
       8
       +
         type t

     

       9
       9
       +
       

     

       10
       10
       +
         (** Get the display name for the address (if any) *)

     

       11
       11
       +
         val name : t -> string option

     

       12
       12
       +
         

     

       13
       13
       +
         (** Get the email address *)

     

       14
       14
       +
         val email : t -> string

     

       15
       15
       +
         

     

       16
       16
       +
         (** Create a new email address *)

     

       17
       17
       +
         val v : 

     

       18
       18
       +
           ?name:string -> 

     

       19
       19
       +
           email:string -> 

     

       20
       20
       +
           unit -> t

     

       21
       21
       +
       end

     

       22
       22
       +
       

     

       23
       23
       +
       (** Represents a group of email addresses.

     

       24
       24
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4 *)

     

       25
       25
       +
       module Email_address_group : sig

     

       26
       26
       +
         type t

     

       27
       27
       +
         

     

       28
       28
       +
         (** Get the name of the group (if any) *)

     

       29
       29
       +
         val name : t -> string option

     

       30
       30
       +
         

     

       31
       31
       +
         (** Get the list of addresses in the group *)

     

       32
       32
       +
         val addresses : t -> Email_address.t list

     

       33
       33
       +
         

     

       34
       34
       +
         (** Create a new address group *)

     

       35
       35
       +
         val v : 

     

       36
       36
       +
           ?name:string -> 

     

       37
       37
       +
           addresses:Email_address.t list -> 

     

       38
       38
       +
           unit -> t

     

       39
       39
       +
       end

     

       40
       40
       +
       

     

       41
       41
       +
       (** Represents a header field (name and raw value).

     

       42
       42
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3 *)

     

       43
       43
       +
       module Email_header : sig

     

       44
       44
       +
         type t

     

       45
       45
       +
         

     

       46
       46
       +
         (** Get the header field name *)

     

       47
       47
       +
         val name : t -> string

     

       48
       48
       +
         

     

       49
       49
       +
         (** Get the raw header field value *)

     

       50
       50
       +
         val value : t -> string

     

       51
       51
       +
         

     

       52
       52
       +
         (** Create a new header field *)

     

       53
       53
       +
         val v : 

     

       54
       54
       +
           name:string -> 

     

       55
       55
       +
           value:string -> 

     

       56
       56
       +
           unit -> t

     

       57
       57
       +
       end

     

       58
       58
       +
       

     

       59
       59
       +
       (** Represents a body part within an Email's MIME structure.

     

       60
       60
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)

     

       61
       61
       +
       module Email_body_part : sig

     

       62
       62
       +
         type t

     

       63
       63
       +
         

     

       64
       64
       +
         (** Get the part ID (null only for multipart types) *)

     

       65
       65
       +
         val id : t -> string option

     

       66
       66
       +
         

     

       67
       67
       +
         (** Get the blob ID (null only for multipart types) *)

     

       68
       68
       +
         val blob_id : t -> id option

     

       69
       69
       +
         

     

       70
       70
       +
         (** Get the size of the part in bytes *)

     

       71
       71
       +
         val size : t -> uint

     

       72
       72
       +
         

     

       73
       73
       +
         (** Get the list of headers for this part *)

     

       74
       74
       +
         val headers : t -> Email_header.t list

     

       75
       75
       +
         

     

       76
       76
       +
         (** Get the filename (if any) *)

     

       77
       77
       +
         val name : t -> string option

     

       78
       78
       +
         

     

       79
       79
       +
         (** Get the MIME type *)

     

       80
       80
       +
         val mime_type : t -> string

     

       81
       81
       +
         

     

       82
       82
       +
         (** Get the charset (if any) *)

     

       83
       83
       +
         val charset : t -> string option

     

       84
       84
       +
         

     

       85
       85
       +
         (** Get the content disposition (if any) *)

     

       86
       86
       +
         val disposition : t -> string option

     

       87
       87
       +
         

     

       88
       88
       +
         (** Get the content ID (if any) *)

     

       89
       89
       +
         val cid : t -> string option

     

       90
       90
       +
         

     

       91
       91
       +
         (** Get the list of languages (if any) *)

     

       92
       92
       +
         val language : t -> string list option

     

       93
       93
       +
         

     

       94
       94
       +
         (** Get the content location (if any) *)

     

       95
       95
       +
         val location : t -> string option

     

       96
       96
       +
         

     

       97
       97
       +
         (** Get the sub-parts (only for multipart types) *)

     

       98
       98
       +
         val sub_parts : t -> t list option

     

       99
       99
       +
         

     

       100
       100
       +
         (** Get any other requested headers (header properties) *)

     

       101
       101
       +
         val other_headers : t -> Yojson.Safe.t string_map

     

       102
       102
       +
         

     

       103
       103
       +
         (** Create a new body part *)

     

       104
       104
       +
         val v :

     

       105
       105
       +
           ?id:string ->

     

       106
       106
       +
           ?blob_id:id ->

     

       107
       107
       +
           size:uint ->

     

       108
       108
       +
           headers:Email_header.t list ->

     

       109
       109
       +
           ?name:string ->

     

       110
       110
       +
           mime_type:string ->

     

       111
       111
       +
           ?charset:string ->

     

       112
       112
       +
           ?disposition:string ->

     

       113
       113
       +
           ?cid:string ->

     

       114
       114
       +
           ?language:string list ->

     

       115
       115
       +
           ?location:string ->

     

       116
       116
       +
           ?sub_parts:t list ->

     

       117
       117
       +
           ?other_headers:Yojson.Safe.t string_map ->

     

       118
       118
       +
           unit -> t

     

       119
       119
       +
       end

     

       120
       120
       +
       

     

       121
       121
       +
       (** Represents the decoded value of a text body part.

     

       122
       122
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)

     

       123
       123
       +
       module Email_body_value : sig

     

       124
       124
       +
         type t 

     

       125
       125
       +
         

     

       126
       126
       +
         (** Get the decoded text content *)

     

       127
       127
       +
         val value : t -> string

     

       128
       128
       +
         

     

       129
       129
       +
         (** Check if there was an encoding problem *)

     

       130
       130
       +
         val has_encoding_problem : t -> bool

     

       131
       131
       +
         

     

       132
       132
       +
         (** Check if the content was truncated *)

     

       133
       133
       +
         val is_truncated : t -> bool

     

       134
       134
       +
         

     

       135
       135
       +
         (** Create a new body value *)

     

       136
       136
       +
         val v :

     

       137
       137
       +
           value:string ->

     

       138
       138
       +
           ?encoding_problem:bool ->

     

       139
       139
       +
           ?truncated:bool ->

     

       140
       140
       +
           unit -> t

     

       141
       141
       +
       end

     

       142
       142
       +
       

     

       143
       143
       +
       (** Type to represent email message flags/keywords.

     

       144
       144
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       145
       145
       +
       module Keywords : sig

     

       146
       146
       +
         (** Represents different types of JMAP keywords *)

     

       147
       147
       +
         type keyword =

     

       148
       148
       +
           | Draft      (** "$draft": The Email is a draft the user is composing *)

     

       149
       149
       +
           | Seen       (** "$seen": The Email has been read *)

     

       150
       150
       +
           | Flagged    (** "$flagged": The Email has been flagged for urgent/special attention *)

     

       151
       151
       +
           | Answered   (** "$answered": The Email has been replied to *)

     

       152
       152
       +
           

     

       153
       153
       +
           (* Common extension keywords from RFC 5788 *)

     

       154
       154
       +
           | Forwarded  (** "$forwarded": The Email has been forwarded *)

     

       155
       155
       +
           | Phishing   (** "$phishing": The Email is likely to be phishing *)

     

       156
       156
       +
           | Junk       (** "$junk": The Email is spam/junk *)

     

       157
       157
       +
           | NotJunk    (** "$notjunk": The Email is explicitly marked as not spam/junk *)

     

       158
       158
       +
           

     

       159
       159
       +
           (* Apple Mail and other vendor extension keywords from draft-ietf-mailmaint-messageflag-mailboxattribute *)

     

       160
       160
       +
           | Notify     (** "$notify": Request to be notified when this email gets a reply *)

     

       161
       161
       +
           | Muted      (** "$muted": Email is muted (notifications disabled) *)

     

       162
       162
       +
           | Followed   (** "$followed": Email thread is followed for notifications *)

     

       163
       163
       +
           | Memo       (** "$memo": Email has a memo/note associated with it *)

     

       164
       164
       +
           | HasMemo    (** "$hasmemo": Email has a memo, annotation or note property *)

     

       165
       165
       +
           | Autosent   (** "$autosent": Email was generated or sent automatically *)

     

       166
       166
       +
           | Unsubscribed (** "$unsubscribed": User has unsubscribed from this sender *)

     

       167
       167
       +
           | CanUnsubscribe (** "$canunsubscribe": Email contains unsubscribe information *)

     

       168
       168
       +
           | Imported   (** "$imported": Email was imported from another system *)

     

       169
       169
       +
           | IsTrusted  (** "$istrusted": Email is from a trusted/verified sender *)

     

       170
       170
       +
           | MaskedEmail (** "$maskedemail": Email is to/from a masked/anonymous address *)

     

       171
       171
       +
           | New        (** "$new": Email was recently delivered *)

     

       172
       172
       +
           

     

       173
       173
       +
           (* Apple Mail flag colors (color bit flags) *)

     

       174
       174
       +
           | MailFlagBit0 (** "$MailFlagBit0": First color flag bit (red) *)

     

       175
       175
       +
           | MailFlagBit1 (** "$MailFlagBit1": Second color flag bit (orange) *)

     

       176
       176
       +
           | MailFlagBit2 (** "$MailFlagBit2": Third color flag bit (yellow) *)

     

       177
       177
       +
           | Custom of string  (** Arbitrary user-defined keyword *)

     

       178
       178
       +
       

     

       179
       179
       +
         (** A set of keywords applied to an email *)

     

       180
       180
       +
         type t = keyword list

     

       181
       181
       +
       

     

       182
       182
       +
         (** Check if an email has the draft flag *)

     

       183
       183
       +
         val is_draft : t -> bool

     

       184
       184
       +
         

     

       185
       185
       +
         (** Check if an email has been read *)

     

       186
       186
       +
         val is_seen : t -> bool

     

       187
       187
       +
         

     

       188
       188
       +
         (** Check if an email has neither been read nor is a draft *)

     

       189
       189
       +
         val is_unread : t -> bool

     

       190
       190
       +
         

     

       191
       191
       +
         (** Check if an email has been flagged *)

     

       192
       192
       +
         val is_flagged : t -> bool

     

       193
       193
       +
         

     

       194
       194
       +
         (** Check if an email has been replied to *)

     

       195
       195
       +
         val is_answered : t -> bool

     

       196
       196
       +
         

     

       197
       197
       +
         (** Check if an email has been forwarded *)

     

       198
       198
       +
         val is_forwarded : t -> bool

     

       199
       199
       +
         

     

       200
       200
       +
         (** Check if an email is marked as likely phishing *)

     

       201
       201
       +
         val is_phishing : t -> bool

     

       202
       202
       +
         

     

       203
       203
       +
         (** Check if an email is marked as junk/spam *)

     

       204
       204
       +
         val is_junk : t -> bool

     

       205
       205
       +
         

     

       206
       206
       +
         (** Check if an email is explicitly marked as not junk/spam *)

     

       207
       207
       +
         val is_not_junk : t -> bool

     

       208
       208
       +
         

     

       209
       209
       +
         (** Check if a specific custom keyword is set *)

     

       210
       210
       +
         val has_keyword : t -> string -> bool

     

       211
       211
       +
         

     

       212
       212
       +
         (** Get a list of all custom keywords (excluding system keywords) *)

     

       213
       213
       +
         val custom_keywords : t -> string list

     

       214
       214
       +
         

     

       215
       215
       +
         (** Add a keyword to the set *)

     

       216
       216
       +
         val add : t -> keyword -> t

     

       217
       217
       +
         

     

       218
       218
       +
         (** Remove a keyword from the set *)

     

       219
       219
       +
         val remove : t -> keyword -> t

     

       220
       220
       +
         

     

       221
       221
       +
         (** Create an empty keyword set *)

     

       222
       222
       +
         val empty : unit -> t

     

       223
       223
       +
         

     

       224
       224
       +
         (** Create a new keyword set with the specified keywords *)

     

       225
       225
       +
         val of_list : keyword list -> t

     

       226
       226
       +
         

     

       227
       227
       +
         (** Get the string representation of a keyword as used in the JMAP protocol *)

     

       228
       228
       +
         val to_string : keyword -> string

     

       229
       229
       +
         

     

       230
       230
       +
         (** Parse a string into a keyword *)

     

       231
       231
       +
         val of_string : string -> keyword

     

       232
       232
       +
         

     

       233
       233
       +
         (** Convert keyword set to string map representation as used in JMAP *)

     

       234
       234
       +
         val to_map : t -> bool string_map

     

       235
       235
       +
       end

     

       236
       236
       +
       

     

       237
       237
       +
       (** Email properties enum.

     

       238
       238
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)

     

       239
       239
       +
       type email_property =

     

       240
       240
       +
         | Id               (** The id of the email *)

     

       241
       241
       +
         | BlobId           (** The id of the blob containing the raw message *)

     

       242
       242
       +
         | ThreadId         (** The id of the thread this email belongs to *)

     

       243
       243
       +
         | MailboxIds       (** The mailboxes this email belongs to *)

     

       244
       244
       +
         | Keywords         (** The keywords/flags for this email *)

     

       245
       245
       +
         | Size             (** Size of the message in bytes *)

     

       246
       246
       +
         | ReceivedAt       (** When the message was received by the server *)

     

       247
       247
       +
         | MessageId        (** Value of the Message-ID header *)

     

       248
       248
       +
         | InReplyTo        (** Value of the In-Reply-To header *)

     

       249
       249
       +
         | References       (** Value of the References header *)

     

       250
       250
       +
         | Sender           (** Value of the Sender header *)

     

       251
       251
       +
         | From             (** Value of the From header *)

     

       252
       252
       +
         | To               (** Value of the To header *)

     

       253
       253
       +
         | Cc               (** Value of the Cc header *)

     

       254
       254
       +
         | Bcc              (** Value of the Bcc header *)

     

       255
       255
       +
         | ReplyTo          (** Value of the Reply-To header *)

     

       256
       256
       +
         | Subject          (** Value of the Subject header *)

     

       257
       257
       +
         | SentAt           (** Value of the Date header *)

     

       258
       258
       +
         | HasAttachment    (** Whether the email has attachments *)

     

       259
       259
       +
         | Preview          (** Preview text of the email *)

     

       260
       260
       +
         | BodyStructure    (** MIME structure of the email *)

     

       261
       261
       +
         | BodyValues       (** Decoded body part values *)

     

       262
       262
       +
         | TextBody         (** Text body parts *)

     

       263
       263
       +
         | HtmlBody         (** HTML body parts *)

     

       264
       264
       +
         | Attachments      (** Attachments *)

     

       265
       265
       +
         | Header of string (** Specific header *)

     

       266
       266
       +
         | Other of string  (** Extension property *)

     

       267
       267
       +
       

     

       268
       268
       +
       (** Represents an Email object.

     

       269
       269
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)

     

       270
       270
       +
       module Email : sig

     

       271
       271
       +
         (** Email type *)

     

       272
       272
       +
         type t

     

       273
       273
       +
         

     

       274
       274
       +
         (** ID of the email *)

     

       275
       275
       +
         val id : t -> id option

     

       276
       276
       +
         

     

       277
       277
       +
         (** ID of the blob containing the raw message *)

     

       278
       278
       +
         val blob_id : t -> id option

     

       279
       279
       +
         

     

       280
       280
       +
         (** ID of the thread this email belongs to *)

     

       281
       281
       +
         val thread_id : t -> id option

     

       282
       282
       +
         

     

       283
       283
       +
         (** The set of mailbox IDs this email belongs to *)

     

       284
       284
       +
         val mailbox_ids : t -> bool id_map option

     

       285
       285
       +
         

     

       286
       286
       +
         (** The set of keywords/flags for this email *)

     

       287
       287
       +
         val keywords : t -> Keywords.t option

     

       288
       288
       +
         

     

       289
       289
       +
         (** Size of the message in bytes *)

     

       290
       290
       +
         val size : t -> uint option

     

       291
       291
       +
         

     

       292
       292
       +
         (** When the message was received by the server *)

     

       293
       293
       +
         val received_at : t -> date option

     

       294
       294
       +
         

     

       295
       295
       +
         (** Subject of the email (if requested) *)

     

       296
       296
       +
         val subject : t -> string option

     

       297
       297
       +
         

     

       298
       298
       +
         (** Preview text of the email (if requested) *)

     

       299
       299
       +
         val preview : t -> string option

     

       300
       300
       +
         

     

       301
       301
       +
         (** From addresses (if requested) *)

     

       302
       302
       +
         val from : t -> Email_address.t list option

     

       303
       303
       +
         

     

       304
       304
       +
         (** To addresses (if requested) *)

     

       305
       305
       +
         val to_ : t -> Email_address.t list option

     

       306
       306
       +
         

     

       307
       307
       +
         (** CC addresses (if requested) *)

     

       308
       308
       +
         val cc : t -> Email_address.t list option

     

       309
       309
       +
         

     

       310
       310
       +
         (** Message ID values (if requested) *)

     

       311
       311
       +
         val message_id : t -> string list option

     

       312
       312
       +
         

     

       313
       313
       +
         (** Get whether the email has attachments (if requested) *)

     

       314
       314
       +
         val has_attachment : t -> bool option

     

       315
       315
       +
         

     

       316
       316
       +
         (** Get text body parts (if requested) *)

     

       317
       317
       +
         val text_body : t -> Email_body_part.t list option

     

       318
       318
       +
         

     

       319
       319
       +
         (** Get HTML body parts (if requested) *)

     

       320
       320
       +
         val html_body : t -> Email_body_part.t list option

     

       321
       321
       +
         

     

       322
       322
       +
         (** Get attachments (if requested) *)

     

       323
       323
       +
         val attachments : t -> Email_body_part.t list option

     

       324
       324
       +
         

     

       325
       325
       +
         (** Create a new Email object from a server response or for a new email *)

     

       326
       326
       +
         val create :

     

       327
       327
       +
           ?id:id ->

     

       328
       328
       +
           ?blob_id:id ->

     

       329
       329
       +
           ?thread_id:id ->

     

       330
       330
       +
           ?mailbox_ids:bool id_map ->

     

       331
       331
       +
           ?keywords:Keywords.t ->

     

       332
       332
       +
           ?size:uint ->

     

       333
       333
       +
           ?received_at:date ->

     

       334
       334
       +
           ?subject:string ->

     

       335
       335
       +
           ?preview:string ->

     

       336
       336
       +
           ?from:Email_address.t list ->

     

       337
       337
       +
           ?to_:Email_address.t list ->

     

       338
       338
       +
           ?cc:Email_address.t list ->

     

       339
       339
       +
           ?message_id:string list ->

     

       340
       340
       +
           ?has_attachment:bool ->

     

       341
       341
       +
           ?text_body:Email_body_part.t list ->

     

       342
       342
       +
           ?html_body:Email_body_part.t list ->

     

       343
       343
       +
           ?attachments:Email_body_part.t list ->

     

       344
       344
       +
           unit -> t

     

       345
       345
       +
           

     

       346
       346
       +
         (** Create a patch object for updating email properties *)

     

       347
       347
       +
         val make_patch :

     

       348
       348
       +
           ?add_keywords:Keywords.t ->

     

       349
       349
       +
           ?remove_keywords:Keywords.t ->

     

       350
       350
       +
           ?add_mailboxes:id list ->

     

       351
       351
       +
           ?remove_mailboxes:id list ->

     

       352
       352
       +
           unit -> Jmap.Methods.patch_object

     

       353
       353
       +
         

     

       354
       354
       +
         (** Extract the ID from an email, returning a Result *)

     

       355
       355
       +
         val get_id : t -> (id, string) result

     

       356
       356
       +
         

     

       357
       357
       +
         (** Take the ID from an email (fails with an exception if not present) *)

     

       358
       358
       +
         val take_id : t -> id

     

       359
       359
       +
       end

     

       360
       360
       +
       

     

       361
       361
       +
       (** Email/import method arguments and responses.

     

       362
       362
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8 *)

     

       363
       363
       +
       module Import : sig

     

       364
       364
       +
         (** Arguments for Email/import method *)

     

       365
       365
       +
         type args = {

     

       366
       366
       +
           account_id : id;

     

       367
       367
       +
           blob_ids : id list;

     

       368
       368
       +
           mailbox_ids : id id_map;

     

       369
       369
       +
           keywords : Keywords.t option;

     

       370
       370
       +
           received_at : date option;

     

       371
       371
       +
         }

     

       372
       372
       +
       

     

       373
       373
       +
         (** Create import arguments *)

     

       374
       374
       +
         val create_args :

     

       375
       375
       +
           account_id:id ->

     

       376
       376
       +
           blob_ids:id list ->

     

       377
       377
       +
           mailbox_ids:id id_map ->

     

       378
       378
       +
           ?keywords:Keywords.t ->

     

       379
       379
       +
           ?received_at:date ->

     

       380
       380
       +
           unit -> args

     

       381
       381
       +
       

     

       382
       382
       +
         (** Response for a single imported email *)

     

       383
       383
       +
         type email_import_result = {

     

       384
       384
       +
           blob_id : id;

     

       385
       385
       +
           email : Email.t;

     

       386
       386
       +
         }

     

       387
       387
       +
       

     

       388
       388
       +
         (** Create an email import result *)

     

       389
       389
       +
         val create_result :

     

       390
       390
       +
           blob_id:id ->

     

       391
       391
       +
           email:Email.t ->

     

       392
       392
       +
           unit -> email_import_result

     

       393
       393
       +
       

     

       394
       394
       +
         (** Response for Email/import method *)

     

       395
       395
       +
         type response = {

     

       396
       396
       +
           account_id : id;

     

       397
       397
       +
           created : email_import_result id_map;

     

       398
       398
       +
           not_created : Jmap.Error.Set_error.t id_map;

     

       399
       399
       +
         }

     

       400
       400
       +
       

     

       401
       401
       +
         (** Create import response *)

     

       402
       402
       +
         val create_response :

     

       403
       403
       +
           account_id:id ->

     

       404
       404
       +
           created:email_import_result id_map ->

     

       405
       405
       +
           not_created:Jmap.Error.Set_error.t id_map ->

     

       406
       406
       +
           unit -> response

     

       407
       407
       +
       end

     

       408
       408
       +
       

     

       409
       409
       +
       (** Email/parse method arguments and responses.

     

       410
       410
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.9> RFC 8621, Section 4.9 *)

     

       411
       411
       +
       module Parse : sig

     

       412
       412
       +
         (** Arguments for Email/parse method *)

     

       413
       413
       +
         type args = {

     

       414
       414
       +
           account_id : id;

     

       415
       415
       +
           blob_ids : id list;

     

       416
       416
       +
           properties : string list option;

     

       417
       417
       +
         }

     

       418
       418
       +
       

     

       419
       419
       +
         (** Create parse arguments *)

     

       420
       420
       +
         val create_args :

     

       421
       421
       +
           account_id:id ->

     

       422
       422
       +
           blob_ids:id list ->

     

       423
       423
       +
           ?properties:string list ->

     

       424
       424
       +
           unit -> args

     

       425
       425
       +
       

     

       426
       426
       +
         (** Response for a single parsed email *)

     

       427
       427
       +
         type email_parse_result = {

     

       428
       428
       +
           blob_id : id;

     

       429
       429
       +
           parsed : Email.t;

     

       430
       430
       +
         }

     

       431
       431
       +
       

     

       432
       432
       +
         (** Create an email parse result *)

     

       433
       433
       +
         val create_result :

     

       434
       434
       +
           blob_id:id ->

     

       435
       435
       +
           parsed:Email.t ->

     

       436
       436
       +
           unit -> email_parse_result

     

       437
       437
       +
       

     

       438
       438
       +
         (** Response for Email/parse method *)

     

       439
       439
       +
         type response = {

     

       440
       440
       +
           account_id : id;

     

       441
       441
       +
           parsed : email_parse_result id_map;

     

       442
       442
       +
           not_parsed : string id_map;

     

       443
       443
       +
         }

     

       444
       444
       +
       

     

       445
       445
       +
         (** Create parse response *)

     

       446
       446
       +
         val create_response :

     

       447
       447
       +
           account_id:id ->

     

       448
       448
       +
           parsed:email_parse_result id_map ->

     

       449
       449
       +
           not_parsed:string id_map ->

     

       450
       450
       +
           unit -> response

     

       451
       451
       +
       end

     

       452
       452
       +
       

     

       453
       453
       +
       (** Email import options. 

     

       454
       454
       +
           @deprecated Use Import.args instead.

     

       455
       455
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8 *)

     

       456
       456
       +
       type email_import_options = {

     

       457
       457
       +
         import_to_mailboxes : id list;

     

       458
       458
       +
         import_keywords : Keywords.t option;

     

       459
       459
       +
         import_received_at : date option;

     

       460
       460
       +
       }

     

       461
       461
       +
       

     

       462
       462
       +
       (** Email/copy method arguments and responses.

     

       463
       463
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7 *)

     

       464
       464
       +
       module Copy : sig

     

       465
       465
       +
         (** Arguments for Email/copy method *)

     

       466
       466
       +
         type args = {

     

       467
       467
       +
           from_account_id : id;

     

       468
       468
       +
           account_id : id;

     

       469
       469
       +
           create : (id * id id_map) id_map;

     

       470
       470
       +
           on_success_destroy_original : bool option;

     

       471
       471
       +
           destroy_from_if_in_state : string option;

     

       472
       472
       +
         }

     

       473
       473
       +
       

     

       474
       474
       +
         (** Create copy arguments *)

     

       475
       475
       +
         val create_args :

     

       476
       476
       +
           from_account_id:id ->

     

       477
       477
       +
           account_id:id ->

     

       478
       478
       +
           create:(id * id id_map) id_map ->

     

       479
       479
       +
           ?on_success_destroy_original:bool ->

     

       480
       480
       +
           ?destroy_from_if_in_state:string ->

     

       481
       481
       +
           unit -> args

     

       482
       482
       +
       

     

       483
       483
       +
         (** Response for Email/copy method *)

     

       484
       484
       +
         type response = {

     

       485
       485
       +
           from_account_id : id;

     

       486
       486
       +
           account_id : id;

     

       487
       487
       +
           created : Email.t id_map option;

     

       488
       488
       +
           not_created : Jmap.Error.Set_error.t id_map option;

     

       489
       489
       +
         }

     

       490
       490
       +
       

     

       491
       491
       +
         (** Create copy response *)

     

       492
       492
       +
         val create_response :

     

       493
       493
       +
           from_account_id:id ->

     

       494
       494
       +
           account_id:id ->

     

       495
       495
       +
           ?created:Email.t id_map ->

     

       496
       496
       +
           ?not_created:Jmap.Error.Set_error.t id_map ->

     

       497
       497
       +
           unit -> response

     

       498
       498
       +
       end

     

       499
       499
       +
       

     

       500
       500
       +
       (** Email copy options.

     

       501
       501
       +
           @deprecated Use Copy.args instead.

     

       502
       502
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7 *)

     

       503
       503
       +
       type email_copy_options = {

     

       504
       504
       +
         copy_to_account_id : id;

     

       505
       505
       +
         copy_to_mailboxes : id list;

     

       506
       506
       +
         copy_on_success_destroy_original : bool option;

     

       507
       507
       +
       }

     

       508
       508
       +
       

     

       509
       509
       +
       (** Convert a property variant to its string representation *)

     

       510
       510
       +
       val email_property_to_string : email_property -> string

     

       511
       511
       +
       

     

       512
       512
       +
       (** Parse a string into a property variant *)

     

       513
       513
       +
       val string_to_email_property : string -> email_property

     

       514
       514
       +
       

     

       515
       515
       +
       (** Get a list of common properties useful for displaying email lists *)

     

       516
       516
       +
       val common_email_properties : email_property list

     

       517
       517
       +
       

     

       518
       518
       +
       (** Get a list of common properties for detailed email view *)

     

       519
       519
       +
       val detailed_email_properties : email_property list

+114

jmap-email/jmap_identity.mli

···

       1
       1
       +
       (** JMAP Identity.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Identity object.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       9
       9
       +
       type t

     

       10
       10
       +
       

     

       11
       11
       +
       (** Get the identity ID (immutable, server-set) *)

     

       12
       12
       +
       val id : t -> id

     

       13
       13
       +
       

     

       14
       14
       +
       (** Get the display name (defaults to "") *)

     

       15
       15
       +
       val name : t -> string

     

       16
       16
       +
       

     

       17
       17
       +
       (** Get the email address (immutable) *)

     

       18
       18
       +
       val email : t -> string

     

       19
       19
       +
       

     

       20
       20
       +
       (** Get the reply-to addresses (if any) *)

     

       21
       21
       +
       val reply_to : t -> Jmap_email_types.Email_address.t list option

     

       22
       22
       +
       

     

       23
       23
       +
       (** Get the bcc addresses (if any) *)

     

       24
       24
       +
       val bcc : t -> Jmap_email_types.Email_address.t list option

     

       25
       25
       +
       

     

       26
       26
       +
       (** Get the plain text signature (defaults to "") *)

     

       27
       27
       +
       val text_signature : t -> string

     

       28
       28
       +
       

     

       29
       29
       +
       (** Get the HTML signature (defaults to "") *)

     

       30
       30
       +
       val html_signature : t -> string

     

       31
       31
       +
       

     

       32
       32
       +
       (** Check if this identity may be deleted (server-set) *)

     

       33
       33
       +
       val may_delete : t -> bool

     

       34
       34
       +
       

     

       35
       35
       +
       (** Create a new identity object *)

     

       36
       36
       +
       val v :

     

       37
       37
       +
         id:id ->

     

       38
       38
       +
         ?name:string ->

     

       39
       39
       +
         email:string ->

     

       40
       40
       +
         ?reply_to:Jmap_email_types.Email_address.t list ->

     

       41
       41
       +
         ?bcc:Jmap_email_types.Email_address.t list ->

     

       42
       42
       +
         ?text_signature:string ->

     

       43
       43
       +
         ?html_signature:string ->

     

       44
       44
       +
         may_delete:bool ->

     

       45
       45
       +
         unit -> t

     

       46
       46
       +
         

     

       47
       47
       +
       (** Types and functions for identity creation and updates *)

     

       48
       48
       +
       module Create : sig

     

       49
       49
       +
         type t

     

       50
       50
       +
         

     

       51
       51
       +
         (** Get the name (if specified) *)

     

       52
       52
       +
         val name : t -> string option

     

       53
       53
       +
         

     

       54
       54
       +
         (** Get the email address *)

     

       55
       55
       +
         val email : t -> string

     

       56
       56
       +
         

     

       57
       57
       +
         (** Get the reply-to addresses (if any) *)

     

       58
       58
       +
         val reply_to : t -> Jmap_email_types.Email_address.t list option

     

       59
       59
       +
         

     

       60
       60
       +
         (** Get the bcc addresses (if any) *)

     

       61
       61
       +
         val bcc : t -> Jmap_email_types.Email_address.t list option

     

       62
       62
       +
         

     

       63
       63
       +
         (** Get the plain text signature (if specified) *)

     

       64
       64
       +
         val text_signature : t -> string option

     

       65
       65
       +
         

     

       66
       66
       +
         (** Get the HTML signature (if specified) *)

     

       67
       67
       +
         val html_signature : t -> string option

     

       68
       68
       +
         

     

       69
       69
       +
         (** Create a new identity creation object *)

     

       70
       70
       +
         val v :

     

       71
       71
       +
           ?name:string ->

     

       72
       72
       +
           email:string ->

     

       73
       73
       +
           ?reply_to:Jmap_email_types.Email_address.t list ->

     

       74
       74
       +
           ?bcc:Jmap_email_types.Email_address.t list ->

     

       75
       75
       +
           ?text_signature:string ->

     

       76
       76
       +
           ?html_signature:string ->

     

       77
       77
       +
           unit -> t

     

       78
       78
       +
           

     

       79
       79
       +
         (** Server response with info about the created identity *)

     

       80
       80
       +
         module Response : sig

     

       81
       81
       +
           type t

     

       82
       82
       +
           

     

       83
       83
       +
           (** Get the server-assigned ID for the created identity *)

     

       84
       84
       +
           val id : t -> id

     

       85
       85
       +
           

     

       86
       86
       +
           (** Check if this identity may be deleted *)

     

       87
       87
       +
           val may_delete : t -> bool

     

       88
       88
       +
           

     

       89
       89
       +
           (** Create a new response object *)

     

       90
       90
       +
           val v :

     

       91
       91
       +
             id:id ->

     

       92
       92
       +
             may_delete:bool ->

     

       93
       93
       +
             unit -> t

     

       94
       94
       +
         end

     

       95
       95
       +
       end

     

       96
       96
       +
       

     

       97
       97
       +
       (** Identity object for update.

     

       98
       98
       +
           Patch object, specific structure not enforced here.

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)

     

       100
       100
       +
       type update = patch_object

     

       101
       101
       +
       

     

       102
       102
       +
       (** Server-set/computed info for updated identity.

     

       103
       103
       +
           Contains only changed server-set props.

     

       104
       104
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)

     

       105
       105
       +
       module Update_response : sig

     

       106
       106
       +
         type t

     

       107
       107
       +
         

     

       108
       108
       +
         (** Convert to a full Identity object (contains only changed server-set props) *)

     

       109
       109
       +
         val to_identity : t -> t

     

       110
       110
       +
         

     

       111
       111
       +
         (** Create from a full Identity object *)

     

       112
       112
       +
         val of_identity : t -> t

     

       113
       113
       +
       end

     

       114
       114
       +

+187

jmap-email/jmap_mailbox.mli

···

       1
       1
       +
       (** JMAP Mailbox.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Standard mailbox roles as defined in RFC 8621.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       9
       9
       +
       type role =

     

       10
       10
       +
         | Inbox     (** Messages in the primary inbox *)

     

       11
       11
       +
         | Archive   (** Archived messages *)

     

       12
       12
       +
         | Drafts    (** Draft messages being composed *)

     

       13
       13
       +
         | Sent      (** Messages that have been sent *)

     

       14
       14
       +
         | Trash     (** Messages that have been deleted *)

     

       15
       15
       +
         | Junk      (** Messages determined to be spam *)

     

       16
       16
       +
         | Important (** Messages deemed important *)

     

       17
       17
       +
         | Snoozed    (** Messages snoozed for later notification/reappearance, from draft-ietf-mailmaint-messageflag-mailboxattribute *)

     

       18
       18
       +
         | Scheduled  (** Messages scheduled for sending at a later time, from draft-ietf-mailmaint-messageflag-mailboxattribute *)

     

       19
       19
       +
         | Memos      (** Messages containing memos or notes, from draft-ietf-mailmaint-messageflag-mailboxattribute *)

     

       20
       20
       +
         

     

       21
       21
       +
         | Other of string (** Custom or non-standard role *)

     

       22
       22
       +
         | None      (** No specific role assigned *)

     

       23
       23
       +
       

     

       24
       24
       +
       (** Mailbox property identifiers.

     

       25
       25
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       26
       26
       +
       type property =

     

       27
       27
       +
         | Id            (** The id of the mailbox *)

     

       28
       28
       +
         | Name          (** The name of the mailbox *)

     

       29
       29
       +
         | ParentId      (** The id of the parent mailbox *)

     

       30
       30
       +
         | Role          (** The role of the mailbox *)

     

       31
       31
       +
         | SortOrder     (** The sort order of the mailbox *)

     

       32
       32
       +
         | TotalEmails   (** The total number of emails in the mailbox *)

     

       33
       33
       +
         | UnreadEmails  (** The number of unread emails in the mailbox *)

     

       34
       34
       +
         | TotalThreads  (** The total number of threads in the mailbox *)

     

       35
       35
       +
         | UnreadThreads (** The number of unread threads in the mailbox *)

     

       36
       36
       +
         | MyRights      (** The rights the user has for the mailbox *)

     

       37
       37
       +
         | IsSubscribed  (** Whether the mailbox is subscribed to *)

     

       38
       38
       +
         | Other of string (** Any server-specific extension properties *)

     

       39
       39
       +
       

     

       40
       40
       +
       (** Mailbox access rights.

     

       41
       41
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       42
       42
       +
       type mailbox_rights = {

     

       43
       43
       +
         may_read_items : bool;

     

       44
       44
       +
         may_add_items : bool;

     

       45
       45
       +
         may_remove_items : bool;

     

       46
       46
       +
         may_set_seen : bool;

     

       47
       47
       +
         may_set_keywords : bool;

     

       48
       48
       +
         may_create_child : bool;

     

       49
       49
       +
         may_rename : bool;

     

       50
       50
       +
         may_delete : bool;

     

       51
       51
       +
         may_submit : bool;

     

       52
       52
       +
       }

     

       53
       53
       +
       

     

       54
       54
       +
       (** Mailbox object.

     

       55
       55
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       56
       56
       +
       type mailbox = {

     

       57
       57
       +
         mailbox_id : id; (** immutable, server-set *)

     

       58
       58
       +
         name : string;

     

       59
       59
       +
         parent_id : id option;

     

       60
       60
       +
         role : role option;

     

       61
       61
       +
         sort_order : uint; (* default: 0 *)

     

       62
       62
       +
         total_emails : uint; (** server-set *)

     

       63
       63
       +
         unread_emails : uint; (** server-set *)

     

       64
       64
       +
         total_threads : uint; (** server-set *)

     

       65
       65
       +
         unread_threads : uint; (** server-set *)

     

       66
       66
       +
         my_rights : mailbox_rights; (** server-set *)

     

       67
       67
       +
         is_subscribed : bool;

     

       68
       68
       +
       }

     

       69
       69
       +
       

     

       70
       70
       +
       (** Mailbox object for creation.

     

       71
       71
       +
           Excludes server-set fields.

     

       72
       72
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       73
       73
       +
       type mailbox_create = {

     

       74
       74
       +
         mailbox_create_name : string;

     

       75
       75
       +
         mailbox_create_parent_id : id option;

     

       76
       76
       +
         mailbox_create_role : role option;

     

       77
       77
       +
         mailbox_create_sort_order : uint option;

     

       78
       78
       +
         mailbox_create_is_subscribed : bool option;

     

       79
       79
       +
       }

     

       80
       80
       +
       

     

       81
       81
       +
       (** Mailbox object for update.

     

       82
       82
       +
           Patch object, specific structure not enforced here.

     

       83
       83
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       84
       84
       +
       type mailbox_update = patch_object

     

       85
       85
       +
       

     

       86
       86
       +
       (** Server-set info for created mailbox.

     

       87
       87
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       88
       88
       +
       type mailbox_created_info = {

     

       89
       89
       +
         mailbox_created_id : id;

     

       90
       90
       +
         mailbox_created_role : role option; (** If default used *)

     

       91
       91
       +
         mailbox_created_sort_order : uint; (** If default used *)

     

       92
       92
       +
         mailbox_created_total_emails : uint;

     

       93
       93
       +
         mailbox_created_unread_emails : uint;

     

       94
       94
       +
         mailbox_created_total_threads : uint;

     

       95
       95
       +
         mailbox_created_unread_threads : uint;

     

       96
       96
       +
         mailbox_created_my_rights : mailbox_rights;

     

       97
       97
       +
         mailbox_created_is_subscribed : bool; (** If default used *)

     

       98
       98
       +
       }

     

       99
       99
       +
       

     

       100
       100
       +
       (** Server-set/computed info for updated mailbox.

     

       101
       101
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       102
       102
       +
       type mailbox_updated_info = mailbox (* Contains only changed server-set props *)

     

       103
       103
       +
       

     

       104
       104
       +
       (** FilterCondition for Mailbox/query.

     

       105
       105
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.3> RFC 8621, Section 2.3 *)

     

       106
       106
       +
       type mailbox_filter_condition = {

     

       107
       107
       +
         filter_parent_id : id option option; (* Use option option for explicit null *)

     

       108
       108
       +
         filter_name : string option;

     

       109
       109
       +
         filter_role : role option option; (* Use option option for explicit null *)

     

       110
       110
       +
         filter_has_any_role : bool option;

     

       111
       111
       +
         filter_is_subscribed : bool option;

     

       112
       112
       +
       }

     

       113
       113
       +
       

     

       114
       114
       +
       (** {2 Role and Property Conversion Functions} *)

     

       115
       115
       +
       

     

       116
       116
       +
       (** Convert a role variant to its string representation *)

     

       117
       117
       +
       val role_to_string : role -> string

     

       118
       118
       +
       

     

       119
       119
       +
       (** Parse a string into a role variant *)

     

       120
       120
       +
       val string_to_role : string -> role

     

       121
       121
       +
       

     

       122
       122
       +
       (** Convert a property variant to its string representation *)

     

       123
       123
       +
       val property_to_string : property -> string

     

       124
       124
       +
       

     

       125
       125
       +
       (** Parse a string into a property variant *)

     

       126
       126
       +
       val string_to_property : string -> property

     

       127
       127
       +
       

     

       128
       128
       +
       (** Get a list of common properties useful for displaying mailboxes *)

     

       129
       129
       +
       val common_properties : property list

     

       130
       130
       +
       

     

       131
       131
       +
       (** Get a list of all standard properties *)

     

       132
       132
       +
       val all_properties : property list

     

       133
       133
       +
       

     

       134
       134
       +
       (** Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)

     

       135
       135
       +
       val is_count_property : property -> bool

     

       136
       136
       +
       

     

       137
       137
       +
       (** {2 Mailbox Creation and Manipulation} *)

     

       138
       138
       +
       

     

       139
       139
       +
       (** Create a set of default rights with all permissions *)

     

       140
       140
       +
       val default_rights : unit -> mailbox_rights

     

       141
       141
       +
       

     

       142
       142
       +
       (** Create a set of read-only rights *)

     

       143
       143
       +
       val readonly_rights : unit -> mailbox_rights

     

       144
       144
       +
       

     

       145
       145
       +
       (** Create a new mailbox object with minimal required fields *)

     

       146
       146
       +
       val create : 

     

       147
       147
       +
         name:string -> 

     

       148
       148
       +
         ?parent_id:id -> 

     

       149
       149
       +
         ?role:role -> 

     

       150
       150
       +
         ?sort_order:uint -> 

     

       151
       151
       +
         ?is_subscribed:bool -> 

     

       152
       152
       +
         unit -> mailbox_create

     

       153
       153
       +
         

     

       154
       154
       +
       (** Build a patch object for updating mailbox properties *)

     

       155
       155
       +
       val update :

     

       156
       156
       +
         ?name:string ->

     

       157
       157
       +
         ?parent_id:id option ->

     

       158
       158
       +
         ?role:role option ->

     

       159
       159
       +
         ?sort_order:uint ->

     

       160
       160
       +
         ?is_subscribed:bool ->

     

       161
       161
       +
         unit -> mailbox_update

     

       162
       162
       +
         

     

       163
       163
       +
       (** Get the list of standard role names and their string representations *)

     

       164
       164
       +
       val standard_role_names : (role * string) list

     

       165
       165
       +
       

     

       166
       166
       +
       (** {2 Filter Construction} *)

     

       167
       167
       +
       

     

       168
       168
       +
       (** Create a filter to match mailboxes with a specific role *)

     

       169
       169
       +
       val filter_has_role : role -> Jmap.Methods.Filter.t

     

       170
       170
       +
       

     

       171
       171
       +
       (** Create a filter to match mailboxes with no role *)

     

       172
       172
       +
       val filter_has_no_role : unit -> Jmap.Methods.Filter.t

     

       173
       173
       +
       

     

       174
       174
       +
       (** Create a filter to match mailboxes that are child of a given parent *)

     

       175
       175
       +
       val filter_has_parent : id -> Jmap.Methods.Filter.t

     

       176
       176
       +
       

     

       177
       177
       +
       (** Create a filter to match mailboxes at the root level (no parent) *)

     

       178
       178
       +
       val filter_is_root : unit -> Jmap.Methods.Filter.t

     

       179
       179
       +
       

     

       180
       180
       +
       (** Create a filter to match subscribed mailboxes *)

     

       181
       181
       +
       val filter_is_subscribed : unit -> Jmap.Methods.Filter.t

     

       182
       182
       +
       

     

       183
       183
       +
       (** Create a filter to match unsubscribed mailboxes *)

     

       184
       184
       +
       val filter_is_not_subscribed : unit -> Jmap.Methods.Filter.t

     

       185
       185
       +
       

     

       186
       186
       +
       (** Create a filter to match mailboxes by name (using case-insensitive substring matching) *)

     

       187
       187
       +
       val filter_name_contains : string -> Jmap.Methods.Filter.t

+89

jmap-email/jmap_search_snippet.mli

···

       1
       1
       +
       (** JMAP Search Snippet.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** SearchSnippet object.

     

       8
       8
       +
           Provides highlighted snippets of emails matching search criteria.

     

       9
       9
       +
           Note: Does not have an 'id' property; the key is the emailId.

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       11
       11
       +
       module SearchSnippet : sig

     

       12
       12
       +
         type t

     

       13
       13
       +
       

     

       14
       14
       +
         (** Get the email ID this snippet is for *)

     

       15
       15
       +
         val email_id : t -> id

     

       16
       16
       +
         

     

       17
       17
       +
         (** Get the highlighted subject snippet (if matched) *)

     

       18
       18
       +
         val subject : t -> string option

     

       19
       19
       +
         

     

       20
       20
       +
         (** Get the highlighted preview snippet (if matched) *)

     

       21
       21
       +
         val preview : t -> string option

     

       22
       22
       +
         

     

       23
       23
       +
         (** Create a new SearchSnippet object *)

     

       24
       24
       +
         val v : 

     

       25
       25
       +
           email_id:id -> 

     

       26
       26
       +
           ?subject:string -> 

     

       27
       27
       +
           ?preview:string -> 

     

       28
       28
       +
           unit -> t

     

       29
       29
       +
       end

     

       30
       30
       +
       

     

       31
       31
       +
       (** {1 SearchSnippet Methods} *)

     

       32
       32
       +
       

     

       33
       33
       +
       (** Arguments for SearchSnippet/get.

     

       34
       34
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5.1> RFC 8621, Section 5.1 *)

     

       35
       35
       +
       module Get_args : sig

     

       36
       36
       +
         type t

     

       37
       37
       +
         

     

       38
       38
       +
         (** The account ID *)

     

       39
       39
       +
         val account_id : t -> id

     

       40
       40
       +
         

     

       41
       41
       +
         (** The filter to use for the search *)

     

       42
       42
       +
         val filter : t -> Filter.t

     

       43
       43
       +
         

     

       44
       44
       +
         (** Email IDs to return snippets for. If null, all matching emails are included *)

     

       45
       45
       +
         val email_ids : t -> id list option

     

       46
       46
       +
         

     

       47
       47
       +
         (** Creation arguments *)

     

       48
       48
       +
         val v :

     

       49
       49
       +
           account_id:id ->

     

       50
       50
       +
           filter:Filter.t ->

     

       51
       51
       +
           ?email_ids:id list ->

     

       52
       52
       +
           unit -> t

     

       53
       53
       +
       end

     

       54
       54
       +
       

     

       55
       55
       +
       (** Response for SearchSnippet/get.

     

       56
       56
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5.1> RFC 8621, Section 5.1 *)

     

       57
       57
       +
       module Get_response : sig

     

       58
       58
       +
         type t

     

       59
       59
       +
         

     

       60
       60
       +
         (** The account ID *)

     

       61
       61
       +
         val account_id : t -> id

     

       62
       62
       +
         

     

       63
       63
       +
         (** The search state string (for caching) *)

     

       64
       64
       +
         val list : t -> SearchSnippet.t id_map

     

       65
       65
       +
         

     

       66
       66
       +
         (** IDs requested that weren't found *)

     

       67
       67
       +
         val not_found : t -> id list

     

       68
       68
       +
         

     

       69
       69
       +
         (** Creation *)

     

       70
       70
       +
         val v :

     

       71
       71
       +
           account_id:id ->

     

       72
       72
       +
           list:SearchSnippet.t id_map ->

     

       73
       73
       +
           not_found:id list ->

     

       74
       74
       +
           unit -> t

     

       75
       75
       +
       end

     

       76
       76
       +
       

     

       77
       77
       +
       (** {1 Helper Functions} *)

     

       78
       78
       +
       

     

       79
       79
       +
       (** Helper to extract all matched keywords from a snippet.

     

       80
       80
       +
           This parses highlighted portions from the snippet to get the actual search terms. *)

     

       81
       81
       +
       val extract_matched_terms : string -> string list

     

       82
       82
       +
       

     

       83
       83
       +
       (** Helper to create a filter that searches in email body text.

     

       84
       84
       +
           This is commonly used for SearchSnippet/get requests. *)

     

       85
       85
       +
       val create_body_text_filter : string -> Filter.t

     

       86
       86
       +
       

     

       87
       87
       +
       (** Helper to create a filter that searches across multiple email fields.

     

       88
       88
       +
           This searches subject, body, and headers for the given text. *)

     

       89
       89
       +
       val create_fulltext_filter : string -> Filter.t

+136

jmap-email/jmap_submission.mli

···

       1
       1
       +
       (** JMAP Email Submission.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Address object for Envelope.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       9
       9
       +
       type envelope_address = {

     

       10
       10
       +
         env_addr_email : string;

     

       11
       11
       +
         env_addr_parameters : Yojson.Safe.t string_map option;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** Envelope object.

     

       15
       15
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       16
       16
       +
       type envelope = {

     

       17
       17
       +
         env_mail_from : envelope_address;

     

       18
       18
       +
         env_rcpt_to : envelope_address list;

     

       19
       19
       +
       }

     

       20
       20
       +
       

     

       21
       21
       +
       (** Delivery status for a recipient.

     

       22
       22
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       23
       23
       +
       type delivery_status = {

     

       24
       24
       +
         delivery_smtp_reply : string;

     

       25
       25
       +
         delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];

     

       26
       26
       +
         delivery_displayed : [ `Yes | `Unknown ];

     

       27
       27
       +
       }

     

       28
       28
       +
       

     

       29
       29
       +
       (** EmailSubmission object.

     

       30
       30
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       31
       31
       +
       type email_submission = {

     

       32
       32
       +
         email_sub_id : id; (** immutable, server-set *)

     

       33
       33
       +
         identity_id : id; (** immutable *)

     

       34
       34
       +
         email_id : id; (** immutable *)

     

       35
       35
       +
         thread_id : id; (** immutable, server-set *)

     

       36
       36
       +
         envelope : envelope option; (** immutable *)

     

       37
       37
       +
         send_at : utc_date; (** immutable, server-set *)

     

       38
       38
       +
         undo_status : [ `Pending | `Final | `Canceled ];

     

       39
       39
       +
         delivery_status : delivery_status string_map option; (** server-set *)

     

       40
       40
       +
         dsn_blob_ids : id list; (** server-set *)

     

       41
       41
       +
         mdn_blob_ids : id list; (** server-set *)

     

       42
       42
       +
       }

     

       43
       43
       +
       

     

       44
       44
       +
       (** EmailSubmission object for creation.

     

       45
       45
       +
           Excludes server-set fields.

     

       46
       46
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       47
       47
       +
       type email_submission_create = {

     

       48
       48
       +
         email_sub_create_identity_id : id;

     

       49
       49
       +
         email_sub_create_email_id : id;

     

       50
       50
       +
         email_sub_create_envelope : envelope option;

     

       51
       51
       +
       }

     

       52
       52
       +
       

     

       53
       53
       +
       (** EmailSubmission object for update.

     

       54
       54
       +
           Only undoStatus can be updated (to 'canceled').

     

       55
       55
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       56
       56
       +
       type email_submission_update = patch_object

     

       57
       57
       +
       

     

       58
       58
       +
       (** Server-set info for created email submission.

     

       59
       59
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       60
       60
       +
       type email_submission_created_info = {

     

       61
       61
       +
         email_sub_created_id : id;

     

       62
       62
       +
         email_sub_created_thread_id : id;

     

       63
       63
       +
         email_sub_created_send_at : utc_date;

     

       64
       64
       +
       }

     

       65
       65
       +
       

     

       66
       66
       +
       (** Server-set/computed info for updated email submission.

     

       67
       67
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       68
       68
       +
       type email_submission_updated_info = email_submission (* Contains only changed server-set props *)

     

       69
       69
       +
       

     

       70
       70
       +
       (** FilterCondition for EmailSubmission/query.

     

       71
       71
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.3> RFC 8621, Section 7.3 *)

     

       72
       72
       +
       type email_submission_filter_condition = {

     

       73
       73
       +
         filter_identity_ids : id list option;

     

       74
       74
       +
         filter_email_ids : id list option;

     

       75
       75
       +
         filter_thread_ids : id list option;

     

       76
       76
       +
         filter_undo_status : [ `Pending | `Final | `Canceled ] option;

     

       77
       77
       +
         filter_before : utc_date option;

     

       78
       78
       +
         filter_after : utc_date option;

     

       79
       79
       +
       }

     

       80
       80
       +
       

     

       81
       81
       +
       (** EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)

     

       82
       82
       +
       module Email_submission_get_args : sig

     

       83
       83
       +
         type t = email_submission Get_args.t

     

       84
       84
       +
       end

     

       85
       85
       +
       

     

       86
       86
       +
       (** EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)

     

       87
       87
       +
       module Email_submission_get_response : sig

     

       88
       88
       +
         type t = email_submission Get_response.t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)

     

       92
       92
       +
       module Email_submission_changes_args : sig

     

       93
       93
       +
         type t = Changes_args.t

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (** EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)

     

       97
       97
       +
       module Email_submission_changes_response : sig

     

       98
       98
       +
         type t = Changes_response.t

     

       99
       99
       +
       end

     

       100
       100
       +
       

     

       101
       101
       +
       (** EmailSubmission/query: Args type (specialized from [Query_args.t]). *)

     

       102
       102
       +
       module Email_submission_query_args : sig

     

       103
       103
       +
         type t = Query_args.t

     

       104
       104
       +
       end

     

       105
       105
       +
       

     

       106
       106
       +
       (** EmailSubmission/query: Response type (specialized from [Query_response.t]). *)

     

       107
       107
       +
       module Email_submission_query_response : sig

     

       108
       108
       +
         type t = Query_response.t

     

       109
       109
       +
       end

     

       110
       110
       +
       

     

       111
       111
       +
       (** EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)

     

       112
       112
       +
       module Email_submission_query_changes_args : sig

     

       113
       113
       +
         type t = Query_changes_args.t

     

       114
       114
       +
       end

     

       115
       115
       +
       

     

       116
       116
       +
       (** EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)

     

       117
       117
       +
       module Email_submission_query_changes_response : sig

     

       118
       118
       +
         type t = Query_changes_response.t

     

       119
       119
       +
       end

     

       120
       120
       +
       

     

       121
       121
       +
       (** EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).

     

       122
       122
       +
           Includes onSuccess arguments.

     

       123
       123
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       124
       124
       +
       type email_submission_set_args = {

     

       125
       125
       +
         set_account_id : id;

     

       126
       126
       +
         set_if_in_state : string option;

     

       127
       127
       +
         set_create : email_submission_create id_map option;

     

       128
       128
       +
         set_update : email_submission_update id_map option;

     

       129
       129
       +
         set_destroy : id list option;

     

       130
       130
       +
         set_on_success_destroy_email : id list option;

     

       131
       131
       +
       }

     

       132
       132
       +
       

     

       133
       133
       +
       (** EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)

     

       134
       134
       +
       module Email_submission_set_response : sig

     

       135
       135
       +
         type t = (email_submission_created_info, email_submission_updated_info) Set_response.t

     

       136
       136
       +
       end

+131

jmap-email/jmap_thread.mli

···

       1
       1
       +
       (** JMAP Thread.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Thread object.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       9
       9
       +
       module Thread : sig

     

       10
       10
       +
         type t

     

       11
       11
       +
       

     

       12
       12
       +
         (** Get the thread ID (server-set, immutable) *)

     

       13
       13
       +
         val id : t -> id

     

       14
       14
       +
         

     

       15
       15
       +
         (** Get the IDs of emails in the thread (server-set) *)

     

       16
       16
       +
         val email_ids : t -> id list

     

       17
       17
       +
         

     

       18
       18
       +
         (** Create a new Thread object *)

     

       19
       19
       +
         val v : id:id -> email_ids:id list -> t

     

       20
       20
       +
       end

     

       21
       21
       +
       

     

       22
       22
       +
       (** Thread properties that can be requested in Thread/get.

     

       23
       23
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)

     

       24
       24
       +
       type property =

     

       25
       25
       +
         | Id        (** The Thread id *)

     

       26
       26
       +
         | EmailIds  (** The list of email IDs in the Thread *)

     

       27
       27
       +
       

     

       28
       28
       +
       (** Convert a property variant to its string representation *)

     

       29
       29
       +
       val property_to_string : property -> string

     

       30
       30
       +
       

     

       31
       31
       +
       (** Parse a string into a property variant *)

     

       32
       32
       +
       val string_to_property : string -> property

     

       33
       33
       +
       

     

       34
       34
       +
       (** Get a list of all standard Thread properties *)

     

       35
       35
       +
       val all_properties : property list

     

       36
       36
       +
       

     

       37
       37
       +
       (** {1 Thread Methods} *)

     

       38
       38
       +
       

     

       39
       39
       +
       (** Arguments for Thread/get - extends standard get arguments.

     

       40
       40
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)

     

       41
       41
       +
       module Get_args : sig

     

       42
       42
       +
         type t

     

       43
       43
       +
       

     

       44
       44
       +
         val account_id : t -> id

     

       45
       45
       +
         val ids : t -> id list option

     

       46
       46
       +
         val properties : t -> string list option

     

       47
       47
       +
       

     

       48
       48
       +
         val v :

     

       49
       49
       +
           account_id:id ->

     

       50
       50
       +
           ?ids:id list ->

     

       51
       51
       +
           ?properties:string list ->

     

       52
       52
       +
           unit -> t

     

       53
       53
       +
       end

     

       54
       54
       +
       

     

       55
       55
       +
       (** Response for Thread/get - extends standard get response.

     

       56
       56
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)

     

       57
       57
       +
       module Get_response : sig

     

       58
       58
       +
         type t

     

       59
       59
       +
       

     

       60
       60
       +
         val account_id : t -> id

     

       61
       61
       +
         val state : t -> string

     

       62
       62
       +
         val list : t -> Thread.t list

     

       63
       63
       +
         val not_found : t -> id list

     

       64
       64
       +
       

     

       65
       65
       +
         val v :

     

       66
       66
       +
           account_id:id ->

     

       67
       67
       +
           state:string ->

     

       68
       68
       +
           list:Thread.t list ->

     

       69
       69
       +
           not_found:id list ->

     

       70
       70
       +
           unit -> t

     

       71
       71
       +
       end

     

       72
       72
       +
       

     

       73
       73
       +
       (** Arguments for Thread/changes - extends standard changes arguments.

     

       74
       74
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.2> RFC 8621, Section 3.2 *)

     

       75
       75
       +
       module Changes_args : sig

     

       76
       76
       +
         type t

     

       77
       77
       +
       

     

       78
       78
       +
         val account_id : t -> id

     

       79
       79
       +
         val since_state : t -> string

     

       80
       80
       +
         val max_changes : t -> uint option

     

       81
       81
       +
       

     

       82
       82
       +
         val v :

     

       83
       83
       +
           account_id:id ->

     

       84
       84
       +
           since_state:string ->

     

       85
       85
       +
           ?max_changes:uint ->

     

       86
       86
       +
           unit -> t

     

       87
       87
       +
       end

     

       88
       88
       +
       

     

       89
       89
       +
       (** Response for Thread/changes - extends standard changes response.

     

       90
       90
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.2> RFC 8621, Section 3.2 *)

     

       91
       91
       +
       module Changes_response : sig

     

       92
       92
       +
         type t

     

       93
       93
       +
       

     

       94
       94
       +
         val account_id : t -> id

     

       95
       95
       +
         val old_state : t -> string

     

       96
       96
       +
         val new_state : t -> string

     

       97
       97
       +
         val has_more_changes : t -> bool

     

       98
       98
       +
         val created : t -> id list

     

       99
       99
       +
         val updated : t -> id list

     

       100
       100
       +
         val destroyed : t -> id list

     

       101
       101
       +
       

     

       102
       102
       +
         val v :

     

       103
       103
       +
           account_id:id ->

     

       104
       104
       +
           old_state:string ->

     

       105
       105
       +
           new_state:string ->

     

       106
       106
       +
           has_more_changes:bool ->

     

       107
       107
       +
           created:id list ->

     

       108
       108
       +
           updated:id list ->

     

       109
       109
       +
           destroyed:id list ->

     

       110
       110
       +
           unit -> t

     

       111
       111
       +
       end

     

       112
       112
       +
       

     

       113
       113
       +
       (** {1 Helper Functions} *)

     

       114
       114
       +
       

     

       115
       115
       +
       (** Create a filter to find threads with specific email ID *)

     

       116
       116
       +
       val filter_has_email : id -> Filter.t

     

       117
       117
       +
       

     

       118
       118
       +
       (** Create a filter to find threads with emails from a specific sender *)

     

       119
       119
       +
       val filter_from : string -> Filter.t

     

       120
       120
       +
       

     

       121
       121
       +
       (** Create a filter to find threads with emails to a specific recipient *)

     

       122
       122
       +
       val filter_to : string -> Filter.t

     

       123
       123
       +
       

     

       124
       124
       +
       (** Create a filter to find threads with specific subject *)

     

       125
       125
       +
       val filter_subject : string -> Filter.t

     

       126
       126
       +
       

     

       127
       127
       +
       (** Create a filter to find threads with emails received before a date *)

     

       128
       128
       +
       val filter_before : date -> Filter.t

     

       129
       129
       +
       

     

       130
       130
       +
       (** Create a filter to find threads with emails received after a date *)

     

       131
       131
       +
       val filter_after : date -> Filter.t

+102

jmap-email/jmap_vacation.mli

···

       1
       1
       +
       (** JMAP Vacation Response.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       open Jmap.Error

     

       7
       7
       +
       

     

       8
       8
       +
       (** VacationResponse object.

     

       9
       9
       +
           Note: id is always "singleton".

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       11
       11
       +
       module Vacation_response : sig

     

       12
       12
       +
         type t

     

       13
       13
       +
         

     

       14
       14
       +
         (** Id of the vacation response (immutable, server-set, MUST be "singleton") *)

     

       15
       15
       +
         val id : t -> id

     

       16
       16
       +
         val is_enabled : t -> bool

     

       17
       17
       +
         val from_date : t -> utc_date option

     

       18
       18
       +
         val to_date : t -> utc_date option

     

       19
       19
       +
         val subject : t -> string option

     

       20
       20
       +
         val text_body : t -> string option

     

       21
       21
       +
         val html_body : t -> string option

     

       22
       22
       +
         

     

       23
       23
       +
         val v :

     

       24
       24
       +
           id:id ->

     

       25
       25
       +
           is_enabled:bool ->

     

       26
       26
       +
           ?from_date:utc_date ->

     

       27
       27
       +
           ?to_date:utc_date ->

     

       28
       28
       +
           ?subject:string ->

     

       29
       29
       +
           ?text_body:string ->

     

       30
       30
       +
           ?html_body:string ->

     

       31
       31
       +
           unit ->

     

       32
       32
       +
           t

     

       33
       33
       +
       end

     

       34
       34
       +
       

     

       35
       35
       +
       (** VacationResponse object for update.

     

       36
       36
       +
           Patch object, specific structure not enforced here.

     

       37
       37
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       38
       38
       +
       type vacation_response_update = patch_object

     

       39
       39
       +
       

     

       40
       40
       +
       (** VacationResponse/get: Args type (specialized from ['record get_args]). *)

     

       41
       41
       +
       module Vacation_response_get_args : sig

     

       42
       42
       +
         type t = Vacation_response.t Get_args.t

     

       43
       43
       +
         

     

       44
       44
       +
         val v :

     

       45
       45
       +
           account_id:id ->

     

       46
       46
       +
           ?ids:id list ->

     

       47
       47
       +
           ?properties:string list ->

     

       48
       48
       +
           unit ->

     

       49
       49
       +
           t

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** VacationResponse/get: Response type (specialized from ['record get_response]). *)

     

       53
       53
       +
       module Vacation_response_get_response : sig 

     

       54
       54
       +
         type t = Vacation_response.t Get_response.t

     

       55
       55
       +
         

     

       56
       56
       +
         val v :

     

       57
       57
       +
           account_id:id ->

     

       58
       58
       +
           state:string ->

     

       59
       59
       +
           list:Vacation_response.t list ->

     

       60
       60
       +
           not_found:id list ->

     

       61
       61
       +
           unit ->

     

       62
       62
       +
           t

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       (** VacationResponse/set: Args type.

     

       66
       66
       +
           Only allows update, id must be "singleton".

     

       67
       67
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       68
       68
       +
       module Vacation_response_set_args : sig

     

       69
       69
       +
         type t

     

       70
       70
       +
         

     

       71
       71
       +
         val account_id : t -> id

     

       72
       72
       +
         val if_in_state : t -> string option

     

       73
       73
       +
         val update : t -> vacation_response_update id_map option

     

       74
       74
       +
         

     

       75
       75
       +
         val v :

     

       76
       76
       +
           account_id:id ->

     

       77
       77
       +
           ?if_in_state:string ->

     

       78
       78
       +
           ?update:vacation_response_update id_map ->

     

       79
       79
       +
           unit ->

     

       80
       80
       +
           t

     

       81
       81
       +
       end

     

       82
       82
       +
       

     

       83
       83
       +
       (** VacationResponse/set: Response type.

     

       84
       84
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       85
       85
       +
       module Vacation_response_set_response : sig

     

       86
       86
       +
         type t

     

       87
       87
       +
         

     

       88
       88
       +
         val account_id : t -> id

     

       89
       89
       +
         val old_state : t -> string option

     

       90
       90
       +
         val new_state : t -> string

     

       91
       91
       +
         val updated : t -> Vacation_response.t option id_map option

     

       92
       92
       +
         val not_updated : t -> Set_error.t id_map option

     

       93
       93
       +
         

     

       94
       94
       +
         val v :

     

       95
       95
       +
           account_id:id ->

     

       96
       96
       +
           ?old_state:string ->

     

       97
       97
       +
           new_state:string ->

     

       98
       98
       +
           ?updated:Vacation_response.t option id_map ->

     

       99
       99
       +
           ?not_updated:Set_error.t id_map ->

     

       100
       100
       +
           unit ->

     

       101
       101
       +
           t

     

       102
       102
       +
       end

+35

jmap-email.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       name: "jmap-email"

     

       3
       3
       +
       version: "~dev"

     

       4
       4
       +
       synopsis: "JMAP Email extensions library (RFC 8621)"

     

       5
       5
       +
       description: """

     

       6
       6
       +
       OCaml implementation of the JMAP Mail extensions protocol as defined in RFC 8621.

     

       7
       7
       +
       Provides type definitions and structures for working with email in JMAP.

     

       8
       8
       +
       """

     

       9
       9
       +
       maintainer: ["user@example.com"]

     

       10
       10
       +
       authors: ["Example User"]

     

       11
       11
       +
       license: "MIT"

     

       12
       12
       +
       homepage: "https://github.com/example/jmap"

     

       13
       13
       +
       bug-reports: "https://github.com/example/jmap/issues"

     

       14
       14
       +
       depends: [

     

       15
       15
       +
         "ocaml" {>= "4.08.0"}

     

       16
       16
       +
         "dune" {>= "3.0"}

     

       17
       17
       +
         "jmap"

     

       18
       18
       +
         "yojson"

     

       19
       19
       +
         "uri"

     

       20
       20
       +
         "odoc" {with-doc}

     

       21
       21
       +
       ]

     

       22
       22
       +
       build: [

     

       23
       23
       +
         ["dune" "subst"] {dev}

     

       24
       24
       +
         [

     

       25
       25
       +
           "dune"

     

       26
       26
       +
           "build"

     

       27
       27
       +
           "-p"

     

       28
       28
       +
           name

     

       29
       29
       +
           "-j"

     

       30
       30
       +
           jobs

     

       31
       31
       +
           "@install"

     

       32
       32
       +
           "@runtest" {with-test}

     

       33
       33
       +
           "@doc" {with-doc}

     

       34
       34
       +
         ]

     

       35
       35
       +
       ]

+62

jmap-unix/README.md

···

       1
       1
       +
       # JMAP Unix Implementation

     

       2
       2
       +
       

     

       3
       3
       +
       This library provides Unix-specific implementation for the core JMAP protocol.

     

       4
       4
       +
       

     

       5
       5
       +
       ## Overview

     

       6
       6
       +
       

     

       7
       7
       +
       Jmap_unix provides the implementation needed to make actual connections to JMAP servers

     

       8
       8
       +
       using OCaml's Unix module. It handles:

     

       9
       9
       +
       

     

       10
       10
       +
       - HTTP connections to JMAP endpoints

     

       11
       11
       +
       - Authentication

     

       12
       12
       +
       - Session discovery

     

       13
       13
       +
       - Request/response handling

     

       14
       14
       +
       - Blob upload/download

     

       15
       15
       +
       - High-level email operations (Jmap_unix.Email)

     

       16
       16
       +
       

     

       17
       17
       +
       ## Usage

     

       18
       18
       +
       

     

       19
       19
       +
       ```ocaml

     

       20
       20
       +
       open Jmap

     

       21
       21
       +
       open Jmap_unix

     

       22
       22
       +
       

     

       23
       23
       +
       (* Create a connection to a JMAP server *)

     

       24
       24
       +
       let credentials = Basic("username", "password") in

     

       25
       25
       +
       let (ctx, session) = Jmap_unix.connect ~host:"jmap.example.com" ~credentials in

     

       26
       26
       +
       

     

       27
       27
       +
       (* Use the connection for JMAP requests *)

     

       28
       28
       +
       let response = Jmap_unix.request ctx request in

     

       29
       29
       +
       

     

       30
       30
       +
       (* Close the connection when done *)

     

       31
       31
       +
       Jmap_unix.close ctx

     

       32
       32
       +
       ```

     

       33
       33
       +
       

     

       34
       34
       +
       ## Email Operations

     

       35
       35
       +
       

     

       36
       36
       +
       The Email module provides high-level operations for working with emails:

     

       37
       37
       +
       

     

       38
       38
       +
       ```ocaml

     

       39
       39
       +
       open Jmap

     

       40
       40
       +
       open Jmap.Unix

     

       41
       41
       +
       

     

       42
       42
       +
       (* Get an email *)

     

       43
       43
       +
       let email = Email.get_email ctx ~account_id ~email_id ()

     

       44
       44
       +
       

     

       45
       45
       +
       (* Search for unread emails *)

     

       46
       46
       +
       let filter = Jmap_email.Email_filter.unread ()

     

       47
       47
       +
       let (ids, emails) = Email.search_emails ctx ~account_id ~filter ()

     

       48
       48
       +
       

     

       49
       49
       +
       (* Mark emails as read *)

     

       50
       50
       +
       Email.mark_as_seen ctx ~account_id ~email_ids:["email1"; "email2"] ()

     

       51
       51
       +
       

     

       52
       52
       +
       (* Move emails to another mailbox *)

     

       53
       53
       +
       Email.move_emails ctx ~account_id ~email_ids ~mailbox_id ()

     

       54
       54
       +
       ```

     

       55
       55
       +
       

     

       56
       56
       +
       ## Dependencies

     

       57
       57
       +
       

     

       58
       58
       +
       - jmap (core library)

     

       59
       59
       +
       - jmap-email (email types and helpers)

     

       60
       60
       +
       - yojson

     

       61
       61
       +
       - uri

     

       62
       62
       +
       - unix

jmap-unix/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap_unix)

     

       3
       3
       +
        (public_name jmap-unix)

     

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

     

       5
       5
       +
        (modules_without_implementation jmap_unix)

     

       6
       6
       +
        (modules jmap_unix))

+359

jmap-unix/jmap_unix.mli

···

       1
       1
       +
       (** Unix-specific JMAP client implementation interface.

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides functions to interact with a JMAP server using

     

       4
       4
       +
           Unix sockets for network communication.

     

       5
       5
       +
           

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4

     

       7
       7
       +
       *)

     

       8
       8
       +
       

     

       9
       9
       +
       (** Configuration options for a JMAP client context *)

     

       10
       10
       +
       type client_config = {

     

       11
       11
       +
         connect_timeout : float option;        (** Connection timeout in seconds *)

     

       12
       12
       +
         request_timeout : float option;        (** Request timeout in seconds *)

     

       13
       13
       +
         max_concurrent_requests : int option;  (** Maximum concurrent requests *)

     

       14
       14
       +
         max_request_size : int option;         (** Maximum request size in bytes *)

     

       15
       15
       +
         user_agent : string option;            (** User-Agent header value *)

     

       16
       16
       +
         authentication_header : string option; (** Custom Authentication header name *)

     

       17
       17
       +
       }

     

       18
       18
       +
       

     

       19
       19
       +
       (** Authentication method options *)

     

       20
       20
       +
       type auth_method = 

     

       21
       21
       +
         | Basic of string * string                  (** Basic auth with username and password *)

     

       22
       22
       +
         | Bearer of string                          (** Bearer token auth *)

     

       23
       23
       +
         | Custom of (string * string)               (** Custom header name and value *)

     

       24
       24
       +
         | Session_cookie of (string * string)       (** Session cookie name and value *)

     

       25
       25
       +
         | No_auth                                   (** No authentication *)

     

       26
       26
       +
       

     

       27
       27
       +
       (** Represents an active JMAP connection context. Opaque type. *)

     

       28
       28
       +
       type context

     

       29
       29
       +
       

     

       30
       30
       +
       (** Represents an active EventSource connection. Opaque type. *)

     

       31
       31
       +
       type event_source_connection

     

       32
       32
       +
       

     

       33
       33
       +
       (** A request builder for constructing and sending JMAP requests *)

     

       34
       34
       +
       type request_builder

     

       35
       35
       +
       

     

       36
       36
       +
       (** Create default configuration options *)

     

       37
       37
       +
       val default_config : unit -> client_config

     

       38
       38
       +
       

     

       39
       39
       +
       (** Create a client context with the specified configuration

     

       40
       40
       +
           @return The context object used for JMAP API calls

     

       41
       41
       +
       *)

     

       42
       42
       +
       val create_client : 

     

       43
       43
       +
         ?config:client_config -> 

     

       44
       44
       +
         unit -> 

     

       45
       45
       +
         context

     

       46
       46
       +
       

     

       47
       47
       +
       (** Connect to a JMAP server and retrieve the session.

     

       48
       48
       +
           This handles discovery (if needed) and authentication.

     

       49
       49
       +
           @param ctx The client context.

     

       50
       50
       +
           @param ?session_url Optional direct URL to the Session resource.

     

       51
       51
       +
           @param ?username Optional username (e.g., email address) for discovery.

     

       52
       52
       +
           @param ?auth_method Authentication method to use (default Basic).

     

       53
       53
       +
           @param credentials Authentication credentials.

     

       54
       54
       +
           @return A result with either (context, session) or an error.

     

       55
       55
       +
       *)

     

       56
       56
       +
       val connect : 

     

       57
       57
       +
         context ->

     

       58
       58
       +
         ?session_url:Uri.t ->

     

       59
       59
       +
         ?username:string ->

     

       60
       60
       +
         host:string -> 

     

       61
       61
       +
         ?port:int -> 

     

       62
       62
       +
         ?auth_method:auth_method ->

     

       63
       63
       +
         unit -> 

     

       64
       64
       +
         (context * Jmap.Session.Session.t) Jmap.Error.result

     

       65
       65
       +
       

     

       66
       66
       +
       (** Create a request builder for constructing a JMAP request.

     

       67
       67
       +
           @param ctx The client context.

     

       68
       68
       +
           @return A request builder object.

     

       69
       69
       +
       *)

     

       70
       70
       +
       val build : context -> request_builder

     

       71
       71
       +
       

     

       72
       72
       +
       (** Set the using capabilities for a request.

     

       73
       73
       +
           @param builder The request builder.

     

       74
       74
       +
           @param capabilities List of capability URIs to use.

     

       75
       75
       +
           @return The updated request builder.

     

       76
       76
       +
       *)

     

       77
       77
       +
       val using : request_builder -> string list -> request_builder

     

       78
       78
       +
       

     

       79
       79
       +
       (** Add a method call to a request builder.

     

       80
       80
       +
           @param builder The request builder.

     

       81
       81
       +
           @param name Method name (e.g., "Email/get").

     

       82
       82
       +
           @param args Method arguments.

     

       83
       83
       +
           @param id Method call ID.

     

       84
       84
       +
           @return The updated request builder.

     

       85
       85
       +
       *)

     

       86
       86
       +
       val add_method_call : 

     

       87
       87
       +
         request_builder -> 

     

       88
       88
       +
         string -> 

     

       89
       89
       +
         Yojson.Safe.t -> 

     

       90
       90
       +
         string -> 

     

       91
       91
       +
         request_builder

     

       92
       92
       +
       

     

       93
       93
       +
       (** Create a reference to a previous method call result.

     

       94
       94
       +
           @param result_of Method call ID to reference.

     

       95
       95
       +
           @param name Path in the response.

     

       96
       96
       +
           @return A ResultReference to use in another method call.

     

       97
       97
       +
       *)

     

       98
       98
       +
       val create_reference : string -> string -> Jmap.Wire.Result_reference.t

     

       99
       99
       +
       

     

       100
       100
       +
       (** Execute a request and return the response.

     

       101
       101
       +
           @param builder The request builder to execute.

     

       102
       102
       +
           @return The JMAP response from the server.

     

       103
       103
       +
       *)

     

       104
       104
       +
       val execute : request_builder -> Jmap.Wire.Response.t Jmap.Error.result 

     

       105
       105
       +
       

     

       106
       106
       +
       (** Perform a JMAP API request.

     

       107
       107
       +
           @param ctx The connection context.

     

       108
       108
       +
           @param request The JMAP request object.

     

       109
       109
       +
           @return The JMAP response from the server.

     

       110
       110
       +
       *)

     

       111
       111
       +
       val request : context -> Jmap.Wire.Request.t -> Jmap.Wire.Response.t Jmap.Error.result

     

       112
       112
       +
       

     

       113
       113
       +
       (** Upload binary data.

     

       114
       114
       +
           @param ctx The connection context.

     

       115
       115
       +
           @param account_id The target account ID.

     

       116
       116
       +
           @param content_type The MIME type of the data.

     

       117
       117
       +
           @param data_stream A stream providing the binary data chunks.

     

       118
       118
       +
           @return A result with either an upload response or an error.

     

       119
       119
       +
       *)

     

       120
       120
       +
       val upload : 

     

       121
       121
       +
         context -> 

     

       122
       122
       +
         account_id:Jmap.Types.id -> 

     

       123
       123
       +
         content_type:string -> 

     

       124
       124
       +
         data_stream:string Seq.t -> 

     

       125
       125
       +
         Jmap.Binary.Upload_response.t Jmap.Error.result

     

       126
       126
       +
       

     

       127
       127
       +
       (** Download binary data.

     

       128
       128
       +
           @param ctx The connection context.

     

       129
       129
       +
           @param account_id The account ID.

     

       130
       130
       +
           @param blob_id The blob ID to download.

     

       131
       131
       +
           @param ?content_type The desired Content-Type for the download response.

     

       132
       132
       +
           @param ?name The desired filename for the download response.

     

       133
       133
       +
           @return A result with either a stream of data chunks or an error.

     

       134
       134
       +
       *)

     

       135
       135
       +
       val download : 

     

       136
       136
       +
         context -> 

     

       137
       137
       +
         account_id:Jmap.Types.id -> 

     

       138
       138
       +
         blob_id:Jmap.Types.id -> 

     

       139
       139
       +
         ?content_type:string -> 

     

       140
       140
       +
         ?name:string -> 

     

       141
       141
       +
         (string Seq.t) Jmap.Error.result

     

       142
       142
       +
       

     

       143
       143
       +
       (** Copy blobs between accounts.

     

       144
       144
       +
           @param ctx The connection context.

     

       145
       145
       +
           @param from_account_id Source account ID.

     

       146
       146
       +
           @param account_id Destination account ID.

     

       147
       147
       +
           @param blob_ids List of blob IDs to copy.

     

       148
       148
       +
           @return A result with either the copy response or an error.

     

       149
       149
       +
       *)

     

       150
       150
       +
       val copy_blobs :

     

       151
       151
       +
         context ->

     

       152
       152
       +
         from_account_id:Jmap.Types.id ->

     

       153
       153
       +
         account_id:Jmap.Types.id ->

     

       154
       154
       +
         blob_ids:Jmap.Types.id list ->

     

       155
       155
       +
         Jmap.Binary.Blob_copy_response.t Jmap.Error.result

     

       156
       156
       +
       

     

       157
       157
       +
       (** Connect to the EventSource for push notifications.

     

       158
       158
       +
           @param ctx The connection context.

     

       159
       159
       +
           @param ?types List of types to subscribe to (default "*").

     

       160
       160
       +
           @param ?close_after Request server to close after first state event.

     

       161
       161
       +
           @param ?ping Request ping interval in seconds (default 0).

     

       162
       162
       +
           @return A result with either a tuple of connection handle and event stream, or an error.

     

       163
       163
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)

     

       164
       164
       +
       val connect_event_source : 

     

       165
       165
       +
         context -> 

     

       166
       166
       +
         ?types:string list -> 

     

       167
       167
       +
         ?close_after:[`State | `No] -> 

     

       168
       168
       +
         ?ping:Jmap.Types.uint ->

     

       169
       169
       +
         (event_source_connection * 

     

       170
       170
       +
          ([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result

     

       171
       171
       +
       

     

       172
       172
       +
       (** Create a websocket connection for JMAP over WebSocket.

     

       173
       173
       +
           @param ctx The connection context.

     

       174
       174
       +
           @return A result with either a websocket connection or an error.

     

       175
       175
       +
           @see <https://www.rfc-editor.org/rfc/rfc8887.html> RFC 8887 *)

     

       176
       176
       +
       val connect_websocket :

     

       177
       177
       +
         context ->

     

       178
       178
       +
         event_source_connection Jmap.Error.result

     

       179
       179
       +
       

     

       180
       180
       +
       (** Send a message over a websocket connection.

     

       181
       181
       +
           @param conn The websocket connection.

     

       182
       182
       +
           @param request The JMAP request to send.

     

       183
       183
       +
           @return A result with either the response or an error.

     

       184
       184
       +
       *)

     

       185
       185
       +
       val websocket_send :

     

       186
       186
       +
         event_source_connection ->

     

       187
       187
       +
         Jmap.Wire.Request.t ->

     

       188
       188
       +
         Jmap.Wire.Response.t Jmap.Error.result

     

       189
       189
       +
       

     

       190
       190
       +
       (** Close an EventSource or WebSocket connection.

     

       191
       191
       +
           @param conn The connection handle.

     

       192
       192
       +
           @return A result with either unit or an error.

     

       193
       193
       +
       *)

     

       194
       194
       +
       val close_connection : event_source_connection -> unit Jmap.Error.result

     

       195
       195
       +
       

     

       196
       196
       +
       (** Close the JMAP connection context. 

     

       197
       197
       +
           @return A result with either unit or an error.

     

       198
       198
       +
       *)

     

       199
       199
       +
       val close : context -> unit Jmap.Error.result

     

       200
       200
       +
       

     

       201
       201
       +
       (** {2 Helper Methods for Common Tasks} *)

     

       202
       202
       +
       

     

       203
       203
       +
       (** Helper to get a single object by ID.

     

       204
       204
       +
           @param ctx The context.

     

       205
       205
       +
           @param method_name The get method (e.g., "Email/get").

     

       206
       206
       +
           @param account_id The account ID.

     

       207
       207
       +
           @param object_id The ID of the object to get.

     

       208
       208
       +
           @param ?properties Optional list of properties to fetch.

     

       209
       209
       +
           @return A result with either the object as JSON or an error.

     

       210
       210
       +
       *)

     

       211
       211
       +
       val get_object :

     

       212
       212
       +
         context ->

     

       213
       213
       +
         method_name:string ->

     

       214
       214
       +
         account_id:Jmap.Types.id ->

     

       215
       215
       +
         object_id:Jmap.Types.id ->

     

       216
       216
       +
         ?properties:string list ->

     

       217
       217
       +
         Yojson.Safe.t Jmap.Error.result

     

       218
       218
       +
       

     

       219
       219
       +
       (** Helper to set up the connection with minimal options.

     

       220
       220
       +
           @param host The JMAP server hostname.

     

       221
       221
       +
           @param username Username for basic auth.

     

       222
       222
       +
           @param password Password for basic auth.

     

       223
       223
       +
           @return A result with either (context, session) or an error.

     

       224
       224
       +
       *)

     

       225
       225
       +
       val quick_connect :

     

       226
       226
       +
         host:string ->

     

       227
       227
       +
         username:string ->

     

       228
       228
       +
         password:string ->

     

       229
       229
       +
         (context * Jmap.Session.Session.t) Jmap.Error.result

     

       230
       230
       +
       

     

       231
       231
       +
       (** Perform a Core/echo request to test connectivity.

     

       232
       232
       +
           @param ctx The JMAP connection context.

     

       233
       233
       +
           @param ?data Optional data to echo back.

     

       234
       234
       +
           @return A result with either the response or an error.

     

       235
       235
       +
       *)

     

       236
       236
       +
       val echo : 

     

       237
       237
       +
         context -> 

     

       238
       238
       +
         ?data:Yojson.Safe.t -> 

     

       239
       239
       +
         unit -> 

     

       240
       240
       +
         Yojson.Safe.t Jmap.Error.result

     

       241
       241
       +
       

     

       242
       242
       +
       (** {2 Email Operations} *)

     

       243
       243
       +
       

     

       244
       244
       +
       (** High-level email operations that map to JMAP email methods *)

     

       245
       245
       +
       module Email : sig

     

       246
       246
       +
         open Jmap_email.Types

     

       247
       247
       +
         

     

       248
       248
       +
         (** Get an email by ID 

     

       249
       249
       +
             @param ctx The JMAP client context

     

       250
       250
       +
             @param account_id The account ID

     

       251
       251
       +
             @param email_id The email ID to fetch

     

       252
       252
       +
             @param ?properties Optional list of properties to fetch

     

       253
       253
       +
             @return The email object or an error

     

       254
       254
       +
         *)

     

       255
       255
       +
         val get_email : 

     

       256
       256
       +
           context -> 

     

       257
       257
       +
           account_id:Jmap.Types.id -> 

     

       258
       258
       +
           email_id:Jmap.Types.id -> 

     

       259
       259
       +
           ?properties:string list -> 

     

       260
       260
       +
           unit -> 

     

       261
       261
       +
           Email.t Jmap.Error.result

     

       262
       262
       +
         

     

       263
       263
       +
         (** Search for emails using a filter

     

       264
       264
       +
             @param ctx The JMAP client context

     

       265
       265
       +
             @param account_id The account ID

     

       266
       266
       +
             @param filter The search filter

     

       267
       267
       +
             @param ?sort Optional sort criteria (default received date newest first)

     

       268
       268
       +
             @param ?limit Optional maximum number of results

     

       269
       269
       +
             @param ?properties Optional properties to fetch for the matching emails

     

       270
       270
       +
             @return The list of matching email IDs and optionally the email objects

     

       271
       271
       +
         *)

     

       272
       272
       +
         val search_emails :

     

       273
       273
       +
           context ->

     

       274
       274
       +
           account_id:Jmap.Types.id ->

     

       275
       275
       +
           filter:Jmap.Methods.Filter.t ->

     

       276
       276
       +
           ?sort:Jmap.Methods.Comparator.t list ->

     

       277
       277
       +
           ?limit:Jmap.Types.uint ->

     

       278
       278
       +
           ?position:int ->

     

       279
       279
       +
           ?properties:string list ->

     

       280
       280
       +
           unit ->

     

       281
       281
       +
           (Jmap.Types.id list * Email.t list option) Jmap.Error.result

     

       282
       282
       +
           

     

       283
       283
       +
         (** Mark multiple emails with a keyword

     

       284
       284
       +
             @param ctx The JMAP client context

     

       285
       285
       +
             @param account_id The account ID

     

       286
       286
       +
             @param email_ids List of email IDs to update

     

       287
       287
       +
             @param keyword The keyword to add

     

       288
       288
       +
             @return The result of the operation

     

       289
       289
       +
         *)

     

       290
       290
       +
         val mark_emails :

     

       291
       291
       +
           context ->

     

       292
       292
       +
           account_id:Jmap.Types.id ->

     

       293
       293
       +
           email_ids:Jmap.Types.id list ->

     

       294
       294
       +
           keyword:Keywords.keyword ->

     

       295
       295
       +
           unit ->

     

       296
       296
       +
           unit Jmap.Error.result

     

       297
       297
       +
           

     

       298
       298
       +
         (** Mark emails as seen/read

     

       299
       299
       +
             @param ctx The JMAP client context

     

       300
       300
       +
             @param account_id The account ID

     

       301
       301
       +
             @param email_ids List of email IDs to mark

     

       302
       302
       +
             @return The result of the operation

     

       303
       303
       +
         *)

     

       304
       304
       +
         val mark_as_seen :

     

       305
       305
       +
           context ->

     

       306
       306
       +
           account_id:Jmap.Types.id ->

     

       307
       307
       +
           email_ids:Jmap.Types.id list ->

     

       308
       308
       +
           unit ->

     

       309
       309
       +
           unit Jmap.Error.result

     

       310
       310
       +
           

     

       311
       311
       +
         (** Mark emails as unseen/unread

     

       312
       312
       +
             @param ctx The JMAP client context

     

       313
       313
       +
             @param account_id The account ID

     

       314
       314
       +
             @param email_ids List of email IDs to mark

     

       315
       315
       +
             @return The result of the operation

     

       316
       316
       +
         *)

     

       317
       317
       +
         val mark_as_unseen :

     

       318
       318
       +
           context ->

     

       319
       319
       +
           account_id:Jmap.Types.id ->

     

       320
       320
       +
           email_ids:Jmap.Types.id list ->

     

       321
       321
       +
           unit ->

     

       322
       322
       +
           unit Jmap.Error.result

     

       323
       323
       +
         

     

       324
       324
       +
         (** Move emails to a different mailbox

     

       325
       325
       +
             @param ctx The JMAP client context

     

       326
       326
       +
             @param account_id The account ID

     

       327
       327
       +
             @param email_ids List of email IDs to move

     

       328
       328
       +
             @param mailbox_id Destination mailbox ID

     

       329
       329
       +
             @param ?remove_from_mailboxes Optional list of source mailbox IDs to remove from

     

       330
       330
       +
             @return The result of the operation

     

       331
       331
       +
         *)

     

       332
       332
       +
         val move_emails :

     

       333
       333
       +
           context ->

     

       334
       334
       +
           account_id:Jmap.Types.id ->

     

       335
       335
       +
           email_ids:Jmap.Types.id list ->

     

       336
       336
       +
           mailbox_id:Jmap.Types.id ->

     

       337
       337
       +
           ?remove_from_mailboxes:Jmap.Types.id list ->

     

       338
       338
       +
           unit ->

     

       339
       339
       +
           unit Jmap.Error.result

     

       340
       340
       +
         

     

       341
       341
       +
         (** Import an RFC822 message

     

       342
       342
       +
             @param ctx The JMAP client context

     

       343
       343
       +
             @param account_id The account ID

     

       344
       344
       +
             @param rfc822 Raw message content

     

       345
       345
       +
             @param mailbox_ids Mailboxes to add the message to

     

       346
       346
       +
             @param ?keywords Optional keywords to set

     

       347
       347
       +
             @param ?received_at Optional received timestamp

     

       348
       348
       +
             @return The ID of the imported email

     

       349
       349
       +
         *)

     

       350
       350
       +
         val import_email :

     

       351
       351
       +
           context ->

     

       352
       352
       +
           account_id:Jmap.Types.id ->

     

       353
       353
       +
           rfc822:string ->

     

       354
       354
       +
           mailbox_ids:Jmap.Types.id list ->

     

       355
       355
       +
           ?keywords:Keywords.t ->

     

       356
       356
       +
           ?received_at:Jmap.Types.date ->

     

       357
       357
       +
           unit ->

     

       358
       358
       +
           Jmap.Types.id Jmap.Error.result

     

       359
       359
       +
       end

+21

jmap-unix.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       name: "jmap-unix"

     

       3
       3
       +
       version: "~dev"

     

       4
       4
       +
       synopsis: "JMAP Unix implementation"

     

       5
       5
       +
       description: "Unix-specific implementation of the JMAP protocol (RFC8620)"

     

       6
       6
       +
       maintainer: ["maintainer@example.com"]

     

       7
       7
       +
       authors: ["JMAP OCaml Team"]

     

       8
       8
       +
       license: "MIT"

     

       9
       9
       +
       homepage: "https://github.com/example/jmap-ocaml"

     

       10
       10
       +
       bug-reports: "https://github.com/example/jmap-ocaml/issues"

     

       11
       11
       +
       depends: [

     

       12
       12
       +
         "ocaml" {>= "4.08.0"}

     

       13
       13
       +
         "dune" {>= "2.0.0"}

     

       14
       14
       +
         "jmap"

     

       15
       15
       +
         "yojson" {>= "1.7.0"}

     

       16
       16
       +
         "uri" {>= "4.0.0"}

     

       17
       17
       +
         "unix"

     

       18
       18
       +
       ]

     

       19
       19
       +
       build: [

     

       20
       20
       +
         ["dune" "build" "-p" name "-j" jobs]

     

       21
       21
       +
       ]

-35

jmap.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "JMAP protocol"

     

       4
       4
       -
       description: "This is all still a work in progress"

     

       5
       5
       -
       maintainer: ["anil@recoil.org"]

     

       6
       6
       -
       authors: ["Anil Madhavapeddy"]

     

       7
       7
       -
       license: "ISC"

     

       8
       8
       -
       homepage: "https://github.com/avsm/jmap"

     

       9
       9
       -
       bug-reports: "https://github.com/avsm/jmap/issues"

     

       10
       10
       -
       depends: [

     

       11
       11
       -
         "dune" {>= "3.17"}

     

       12
       12
       -
         "ocaml" {>= "5.2.0"}

     

       13
       13
       -
         "ptime"

     

       14
       14
       -
         "cohttp"

     

       15
       15
       -
         "cohttp-lwt-unix"

     

       16
       16
       -
         "ezjsonm"

     

       17
       17
       -
         "uri"

     

       18
       18
       -
         "lwt"

     

       19
       19
       -
         "odoc" {with-doc}

     

       20
       20
       -
       ]

     

       21
       21
       -
       build: [

     

       22
       22
       -
         ["dune" "subst"] {dev}

     

       23
       23
       -
         [

     

       24
       24
       -
           "dune"

     

       25
       25
       -
           "build"

     

       26
       26
       -
           "-p"

     

       27
       27
       -
           name

     

       28
       28
       -
           "-j"

     

       29
       29
       -
           jobs

     

       30
       30
       -
           "@install"

     

       31
       31
       -
           "@runtest" {with-test}

     

       32
       32
       -
           "@doc" {with-doc}

     

       33
       33
       -
         ]

     

       34
       34
       -
       ]

     

       35
       35
       -
       dev-repo: "git+https://github.com/avsm/jmap.git"

-11

lib/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name jmap)

     

       3
       3
       -
        (public_name jmap)

     

       4
       4
       -
        (modules jmap)

     

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

     

       6
       6
       -
       

     

       7
       7
       -
       (library

     

       8
       8
       -
        (name jmap_mail)

     

       9
       9
       -
        (public_name jmap.mail)

     

       10
       10
       -
        (modules jmap_mail)

     

       11
       11
       -
        (libraries jmap))

-783

lib/jmap.ml

···

       1
       1
       -
       (**

     

       2
       2
       -
        * JMAP protocol implementation based on RFC8620

     

       3
       3
       -
        * https://datatracker.ietf.org/doc/html/rfc8620

     

       4
       4
       -
        *)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Whether to redact sensitive information *)

     

       7
       7
       -
       let should_redact_sensitive = ref true

     

       8
       8
       -
       

     

       9
       9
       -
       (** Initialize and configure logging for JMAP *)

     

       10
       10
       -
       let init_logging ?(level=2) ?(enable_logs=true) ?(redact_sensitive=true) () =

     

       11
       11
       -
         if enable_logs then begin

     

       12
       12
       -
           Logs.set_reporter (Logs.format_reporter ());

     

       13
       13
       -
           match level with

     

       14
       14
       -
           | 0 -> Logs.set_level None

     

       15
       15
       -
           | 1 -> Logs.set_level (Some Logs.Error)

     

       16
       16
       -
           | 2 -> Logs.set_level (Some Logs.Info)

     

       17
       17
       -
           | 3 -> Logs.set_level (Some Logs.Debug)

     

       18
       18
       -
           | _ -> Logs.set_level (Some Logs.Debug)

     

       19
       19
       -
         end else

     

       20
       20
       -
           Logs.set_level None;

     

       21
       21
       -
         should_redact_sensitive := redact_sensitive

     

       22
       22
       -
       

     

       23
       23
       -
       (** Redact sensitive data like tokens *)

     

       24
       24
       -
       let redact_token ?(redact=true) token =

     

       25
       25
       -
         if redact && !should_redact_sensitive && String.length token > 8 then

     

       26
       26
       -
           let prefix = String.sub token 0 4 in

     

       27
       27
       -
           let suffix = String.sub token (String.length token - 4) 4 in

     

       28
       28
       -
           prefix ^ "..." ^ suffix

     

       29
       29
       -
         else

     

       30
       30
       -
           token

     

       31
       31
       -
       

     

       32
       32
       -
       (** Redact sensitive headers like Authorization *)

     

       33
       33
       -
       let redact_headers headers =

     

       34
       34
       -
         List.map (fun (k, v) ->

     

       35
       35
       -
           if String.lowercase_ascii k = "authorization" then

     

       36
       36
       -
             if !should_redact_sensitive then

     

       37
       37
       -
               let parts = String.split_on_char ' ' v in

     

       38
       38
       -
               match parts with

     

       39
       39
       -
               | scheme :: token :: _ -> (k, scheme ^ " " ^ redact_token token)

     

       40
       40
       -
               | _ -> (k, v)

     

       41
       41
       -
             else (k, v)

     

       42
       42
       -
           else (k, v)

     

       43
       43
       -
         ) headers

     

       44
       44
       -
       

     

       45
       45
       -
       (* Initialize logging with defaults *)

     

       46
       46
       -
       let () = init_logging ()

     

       47
       47
       -
       

     

       48
       48
       -
       (** Module for managing JMAP capability URIs and other constants *)

     

       49
       49
       -
       module Capability = struct

     

       50
       50
       -
         (** JMAP capability URI as specified in RFC8620 *)

     

       51
       51
       -
         let core_uri = "urn:ietf:params:jmap:core"

     

       52
       52
       -
       

     

       53
       53
       -
         (** All JMAP capability types *)

     

       54
       54
       -
         type t = 

     

       55
       55
       -
           | Core       (** Core JMAP capability *)

     

       56
       56
       -
           | Extension of string  (** Extension capabilities *)

     

       57
       57
       -
       

     

       58
       58
       -
         (** Convert capability to URI string *)

     

       59
       59
       -
         let to_string = function

     

       60
       60
       -
           | Core -> core_uri

     

       61
       61
       -
           | Extension s -> s

     

       62
       62
       -
       

     

       63
       63
       -
         (** Parse a string to a capability, returns Extension for non-core capabilities *)

     

       64
       64
       -
         let of_string s =

     

       65
       65
       -
           if s = core_uri then Core

     

       66
       66
       -
           else Extension s

     

       67
       67
       -
           

     

       68
       68
       -
         (** Check if a capability matches a core capability *)

     

       69
       69
       -
         let is_core = function

     

       70
       70
       -
           | Core -> true

     

       71
       71
       -
           | Extension _ -> false

     

       72
       72
       -
       

     

       73
       73
       -
         (** Check if a capability string is a core capability *)

     

       74
       74
       -
         let is_core_string s = s = core_uri

     

       75
       75
       -
       

     

       76
       76
       -
         (** Create a list of capability strings *)

     

       77
       77
       -
         let strings_of_capabilities capabilities =

     

       78
       78
       -
           List.map to_string capabilities

     

       79
       79
       -
       end

     

       80
       80
       -
       

     

       81
       81
       -
       module Types = struct

     

       82
       82
       -
         (** Id string as per Section 1.2 *)

     

       83
       83
       -
         type id = string

     

       84
       84
       -
       

     

       85
       85
       -
         (** Int bounded within the range -2^53+1 to 2^53-1 as per Section 1.3 *)

     

       86
       86
       -
         type int_t = int

     

       87
       87
       -
       

     

       88
       88
       -
         (** UnsignedInt bounded within the range 0 to 2^53-1 as per Section 1.3 *)

     

       89
       89
       -
         type unsigned_int = int

     

       90
       90
       -
       

     

       91
       91
       -
         (** Date string in RFC3339 format as per Section 1.4 *)

     

       92
       92
       -
         type date = string

     

       93
       93
       -
       

     

       94
       94
       -
         (** UTCDate is a Date with 'Z' time zone as per Section 1.4 *)

     

       95
       95
       -
         type utc_date = string

     

       96
       96
       -
       

     

       97
       97
       -
         (** Error object as per Section 3.6.2 *)

     

       98
       98
       -
         type error = {

     

       99
       99
       -
           type_: string;

     

       100
       100
       -
           description: string option;

     

       101
       101
       -
         }

     

       102
       102
       -
       

     

       103
       103
       -
         (** Set error object as per Section 5.3 *)

     

       104
       104
       -
         type set_error = {

     

       105
       105
       -
           type_: string;

     

       106
       106
       -
           description: string option;

     

       107
       107
       -
           properties: string list option;

     

       108
       108
       -
           (* Additional properties for specific error types *)

     

       109
       109
       -
           existing_id: id option; (* For alreadyExists error *)

     

       110
       110
       -
         }

     

       111
       111
       -
       

     

       112
       112
       -
         (** Invocation object as per Section 3.2 *)

     

       113
       113
       -
         type 'a invocation = {

     

       114
       114
       -
           name: string;

     

       115
       115
       -
           arguments: 'a;

     

       116
       116
       -
           method_call_id: string;

     

       117
       117
       -
         }

     

       118
       118
       -
       

     

       119
       119
       -
         (** ResultReference object as per Section 3.7 *)

     

       120
       120
       -
         type result_reference = {

     

       121
       121
       -
           result_of: string;

     

       122
       122
       -
           name: string;

     

       123
       123
       -
           path: string;

     

       124
       124
       -
         }

     

       125
       125
       -
       

     

       126
       126
       -
         (** FilterOperator, FilterCondition and Filter as per Section 5.5 *)

     

       127
       127
       -
         type filter_operator = {

     

       128
       128
       -
           operator: string; (* "AND", "OR", "NOT" *)

     

       129
       129
       -
           conditions: filter list;

     

       130
       130
       -
         }

     

       131
       131
       -
         and filter_condition = (string * Ezjsonm.value) list

     

       132
       132
       -
         and filter = 

     

       133
       133
       -
           | Operator of filter_operator

     

       134
       134
       -
           | Condition of filter_condition

     

       135
       135
       -
       

     

       136
       136
       -
         (** Comparator object for sorting as per Section 5.5 *)

     

       137
       137
       -
         type comparator = {

     

       138
       138
       -
           property: string;

     

       139
       139
       -
           is_ascending: bool option; (* Optional, defaults to true *)

     

       140
       140
       -
           collation: string option;  (* Optional, server-dependent default *)

     

       141
       141
       -
         }

     

       142
       142
       -
       

     

       143
       143
       -
         (** PatchObject as per Section 5.3 *)

     

       144
       144
       -
         type patch_object = (string * Ezjsonm.value) list

     

       145
       145
       -
       

     

       146
       146
       -
         (** AddedItem structure as per Section 5.6 *)

     

       147
       147
       -
         type added_item = {

     

       148
       148
       -
           id: id;

     

       149
       149
       -
           index: unsigned_int;

     

       150
       150
       -
         }

     

       151
       151
       -
       

     

       152
       152
       -
         (** Account object as per Section 1.6.2 *)

     

       153
       153
       -
         type account = {

     

       154
       154
       -
           name: string;

     

       155
       155
       -
           is_personal: bool;

     

       156
       156
       -
           is_read_only: bool;

     

       157
       157
       -
           account_capabilities: (string * Ezjsonm.value) list;

     

       158
       158
       -
         }

     

       159
       159
       -
       

     

       160
       160
       -
         (** Core capability object as per Section 2 *)

     

       161
       161
       -
         type core_capability = {

     

       162
       162
       -
           max_size_upload: unsigned_int;

     

       163
       163
       -
           max_concurrent_upload: unsigned_int;

     

       164
       164
       -
           max_size_request: unsigned_int;

     

       165
       165
       -
           max_concurrent_requests: unsigned_int;

     

       166
       166
       -
           max_calls_in_request: unsigned_int;

     

       167
       167
       -
           max_objects_in_get: unsigned_int;

     

       168
       168
       -
           max_objects_in_set: unsigned_int;

     

       169
       169
       -
           collation_algorithms: string list;

     

       170
       170
       -
         }

     

       171
       171
       -
       

     

       172
       172
       -
         (** PushSubscription keys object as per Section 7.2 *)

     

       173
       173
       -
         type push_keys = {

     

       174
       174
       -
           p256dh: string;

     

       175
       175
       -
           auth: string;

     

       176
       176
       -
         }

     

       177
       177
       -
       

     

       178
       178
       -
         (** Session object as per Section 2 *)

     

       179
       179
       -
         type session = {

     

       180
       180
       -
           capabilities: (string * Ezjsonm.value) list;

     

       181
       181
       -
           accounts: (id * account) list;

     

       182
       182
       -
           primary_accounts: (string * id) list;

     

       183
       183
       -
           username: string;

     

       184
       184
       -
           api_url: string;

     

       185
       185
       -
           download_url: string;

     

       186
       186
       -
           upload_url: string;

     

       187
       187
       -
           event_source_url: string option;

     

       188
       188
       -
           state: string;

     

       189
       189
       -
         }

     

       190
       190
       -
       

     

       191
       191
       -
         (** TypeState for state changes as per Section 7.1 *)

     

       192
       192
       -
         type type_state = (string * string) list

     

       193
       193
       -
       

     

       194
       194
       -
         (** StateChange object as per Section 7.1 *)

     

       195
       195
       -
         type state_change = {

     

       196
       196
       -
           changed: (id * type_state) list;

     

       197
       197
       -
         }

     

       198
       198
       -
       

     

       199
       199
       -
         (** PushVerification object as per Section 7.2.2 *)

     

       200
       200
       -
         type push_verification = {

     

       201
       201
       -
           push_subscription_id: id;

     

       202
       202
       -
           verification_code: string;

     

       203
       203
       -
         }

     

       204
       204
       -
       

     

       205
       205
       -
         (** PushSubscription object as per Section 7.2 *)

     

       206
       206
       -
         type push_subscription = {

     

       207
       207
       -
           id: id;

     

       208
       208
       -
           device_client_id: string;

     

       209
       209
       -
           url: string;

     

       210
       210
       -
           keys: push_keys option;

     

       211
       211
       -
           verification_code: string option;

     

       212
       212
       -
           expires: utc_date option;

     

       213
       213
       -
           types: string list option;

     

       214
       214
       -
         }

     

       215
       215
       -
       

     

       216
       216
       -
         (** Request object as per Section 3.3 *)

     

       217
       217
       -
         type request = {

     

       218
       218
       -
           using: string list;

     

       219
       219
       -
           method_calls: Ezjsonm.value invocation list;

     

       220
       220
       -
           created_ids: (id * id) list option;

     

       221
       221
       -
         }

     

       222
       222
       -
       

     

       223
       223
       -
         (** Response object as per Section 3.4 *)

     

       224
       224
       -
         type response = {

     

       225
       225
       -
           method_responses: Ezjsonm.value invocation list;

     

       226
       226
       -
           created_ids: (id * id) list option;

     

       227
       227
       -
           session_state: string;

     

       228
       228
       -
         }

     

       229
       229
       -
       

     

       230
       230
       -
         (** Standard method arguments and responses *)

     

       231
       231
       -
       

     

       232
       232
       -
         (** Arguments for Foo/get method as per Section 5.1 *)

     

       233
       233
       -
         type 'a get_arguments = {

     

       234
       234
       -
           account_id: id;

     

       235
       235
       -
           ids: id list option;

     

       236
       236
       -
           properties: string list option;

     

       237
       237
       -
         }

     

       238
       238
       -
       

     

       239
       239
       -
         (** Response for Foo/get method as per Section 5.1 *)

     

       240
       240
       -
         type 'a get_response = {

     

       241
       241
       -
           account_id: id;

     

       242
       242
       -
           state: string;

     

       243
       243
       -
           list: 'a list;

     

       244
       244
       -
           not_found: id list;

     

       245
       245
       -
         }

     

       246
       246
       -
       

     

       247
       247
       -
         (** Arguments for Foo/changes method as per Section 5.2 *)

     

       248
       248
       -
         type changes_arguments = {

     

       249
       249
       -
           account_id: id;

     

       250
       250
       -
           since_state: string;

     

       251
       251
       -
           max_changes: unsigned_int option;

     

       252
       252
       -
         }

     

       253
       253
       -
       

     

       254
       254
       -
         (** Response for Foo/changes method as per Section 5.2 *)

     

       255
       255
       -
         type changes_response = {

     

       256
       256
       -
           account_id: id;

     

       257
       257
       -
           old_state: string;

     

       258
       258
       -
           new_state: string;

     

       259
       259
       -
           has_more_changes: bool;

     

       260
       260
       -
           created: id list;

     

       261
       261
       -
           updated: id list;

     

       262
       262
       -
           destroyed: id list;

     

       263
       263
       -
         }

     

       264
       264
       -
       

     

       265
       265
       -
         (** Arguments for Foo/set method as per Section 5.3 *)

     

       266
       266
       -
         type 'a set_arguments = {

     

       267
       267
       -
           account_id: id;

     

       268
       268
       -
           if_in_state: string option;

     

       269
       269
       -
           create: (id * 'a) list option;

     

       270
       270
       -
           update: (id * patch_object) list option;

     

       271
       271
       -
           destroy: id list option;

     

       272
       272
       -
         }

     

       273
       273
       -
       

     

       274
       274
       -
         (** Response for Foo/set method as per Section 5.3 *)

     

       275
       275
       -
         type 'a set_response = {

     

       276
       276
       -
           account_id: id;

     

       277
       277
       -
           old_state: string option;

     

       278
       278
       -
           new_state: string;

     

       279
       279
       -
           created: (id * 'a) list option;

     

       280
       280
       -
           updated: (id * 'a option) list option;

     

       281
       281
       -
           destroyed: id list option;

     

       282
       282
       -
           not_created: (id * set_error) list option;

     

       283
       283
       -
           not_updated: (id * set_error) list option;

     

       284
       284
       -
           not_destroyed: (id * set_error) list option;

     

       285
       285
       -
         }

     

       286
       286
       -
       

     

       287
       287
       -
         (** Arguments for Foo/copy method as per Section 5.4 *)

     

       288
       288
       -
         type 'a copy_arguments = {

     

       289
       289
       -
           from_account_id: id;

     

       290
       290
       -
           if_from_in_state: string option;

     

       291
       291
       -
           account_id: id;

     

       292
       292
       -
           if_in_state: string option;

     

       293
       293
       -
           create: (id * 'a) list;

     

       294
       294
       -
           on_success_destroy_original: bool option;

     

       295
       295
       -
           destroy_from_if_in_state: string option;

     

       296
       296
       -
         }

     

       297
       297
       -
       

     

       298
       298
       -
         (** Response for Foo/copy method as per Section 5.4 *)

     

       299
       299
       -
         type 'a copy_response = {

     

       300
       300
       -
           from_account_id: id;

     

       301
       301
       -
           account_id: id;

     

       302
       302
       -
           old_state: string option;

     

       303
       303
       -
           new_state: string;

     

       304
       304
       -
           created: (id * 'a) list option;

     

       305
       305
       -
           not_created: (id * set_error) list option;

     

       306
       306
       -
         }

     

       307
       307
       -
       

     

       308
       308
       -
         (** Arguments for Foo/query method as per Section 5.5 *)

     

       309
       309
       -
         type query_arguments = {

     

       310
       310
       -
           account_id: id;

     

       311
       311
       -
           filter: filter option;

     

       312
       312
       -
           sort: comparator list option;

     

       313
       313
       -
           position: int_t option;

     

       314
       314
       -
           anchor: id option;

     

       315
       315
       -
           anchor_offset: int_t option;

     

       316
       316
       -
           limit: unsigned_int option;

     

       317
       317
       -
           calculate_total: bool option;

     

       318
       318
       -
         }

     

       319
       319
       -
       

     

       320
       320
       -
         (** Response for Foo/query method as per Section 5.5 *)

     

       321
       321
       -
         type query_response = {

     

       322
       322
       -
           account_id: id;

     

       323
       323
       -
           query_state: string;

     

       324
       324
       -
           can_calculate_changes: bool;

     

       325
       325
       -
           position: unsigned_int;

     

       326
       326
       -
           ids: id list;

     

       327
       327
       -
           total: unsigned_int option;

     

       328
       328
       -
           limit: unsigned_int option;

     

       329
       329
       -
         }

     

       330
       330
       -
       

     

       331
       331
       -
         (** Arguments for Foo/queryChanges method as per Section 5.6 *)

     

       332
       332
       -
         type query_changes_arguments = {

     

       333
       333
       -
           account_id: id;

     

       334
       334
       -
           filter: filter option;

     

       335
       335
       -
           sort: comparator list option;

     

       336
       336
       -
           since_query_state: string;

     

       337
       337
       -
           max_changes: unsigned_int option;

     

       338
       338
       -
           up_to_id: id option;

     

       339
       339
       -
           calculate_total: bool option;

     

       340
       340
       -
         }

     

       341
       341
       -
       

     

       342
       342
       -
         (** Response for Foo/queryChanges method as per Section 5.6 *)

     

       343
       343
       -
         type query_changes_response = {

     

       344
       344
       -
           account_id: id;

     

       345
       345
       -
           old_query_state: string;

     

       346
       346
       -
           new_query_state: string;

     

       347
       347
       -
           total: unsigned_int option;

     

       348
       348
       -
           removed: id list;

     

       349
       349
       -
           added: added_item list option;

     

       350
       350
       -
         }

     

       351
       351
       -
       

     

       352
       352
       -
         (** Arguments for Blob/copy method as per Section 6.3 *)

     

       353
       353
       -
         type blob_copy_arguments = {

     

       354
       354
       -
           from_account_id: id;

     

       355
       355
       -
           account_id: id;

     

       356
       356
       -
           blob_ids: id list;

     

       357
       357
       -
         }

     

       358
       358
       -
       

     

       359
       359
       -
         (** Response for Blob/copy method as per Section 6.3 *)

     

       360
       360
       -
         type blob_copy_response = {

     

       361
       361
       -
           from_account_id: id;

     

       362
       362
       -
           account_id: id;

     

       363
       363
       -
           copied: (id * id) list option;

     

       364
       364
       -
           not_copied: (id * set_error) list option;

     

       365
       365
       -
         }

     

       366
       366
       -
       

     

       367
       367
       -
         (** Upload response as per Section 6.1 *)

     

       368
       368
       -
         type upload_response = {

     

       369
       369
       -
           account_id: id;

     

       370
       370
       -
           blob_id: id;

     

       371
       371
       -
           type_: string;

     

       372
       372
       -
           size: unsigned_int;

     

       373
       373
       -
         }

     

       374
       374
       -
       

     

       375
       375
       -
         (** Problem details object as per RFC7807 and Section 3.6.1 *)

     

       376
       376
       -
         type problem_details = {

     

       377
       377
       -
           type_: string;

     

       378
       378
       -
           status: int option;

     

       379
       379
       -
           detail: string option;

     

       380
       380
       -
           limit: string option; (* For "limit" error *)

     

       381
       381
       -
         }

     

       382
       382
       -
       end

     

       383
       383
       -
       

     

       384
       384
       -
       (** Module for working with ResultReferences as described in Section 3.7 of RFC8620 *)

     

       385
       385
       -
       module ResultReference = struct

     

       386
       386
       -
         open Types

     

       387
       387
       -
       

     

       388
       388
       -
         (** Create a reference to a previous method result *)

     

       389
       389
       -
         let create ~result_of ~name ~path = 

     

       390
       390
       -
           { result_of; name; path }

     

       391
       391
       -
         

     

       392
       392
       -
         (** Create a JSON pointer path to access a specific property *)

     

       393
       393
       -
         let property_path property =

     

       394
       394
       -
           "/" ^ property

     

       395
       395
       -
         

     

       396
       396
       -
         (** Create a JSON pointer path to access all items in an array with a specific property *)

     

       397
       397
       -
         let array_items_path ?(property="") array_property =

     

       398
       398
       -
           let base = "/" ^ array_property ^ "/*" in

     

       399
       399
       -
           if property = "" then base

     

       400
       400
       -
           else base ^ "/" ^ property

     

       401
       401
       -
         

     

       402
       402
       -
         (** Create argument with result reference.

     

       403
       403
       -
             Returns string key prefixed with # and ResultReference value. *)

     

       404
       404
       -
         let reference_arg arg_name ref_obj =

     

       405
       405
       -
           (* Prefix argument name with # *)

     

       406
       406
       -
           let prefixed_name = "#" ^ arg_name in

     

       407
       407
       -
           

     

       408
       408
       -
           (* Convert reference object to JSON *)

     

       409
       409
       -
           let json_value = `O [

     

       410
       410
       -
             ("resultOf", `String ref_obj.result_of);

     

       411
       411
       -
             ("name", `String ref_obj.name);

     

       412
       412
       -
             ("path", `String ref_obj.path)

     

       413
       413
       -
           ] in

     

       414
       414
       -
           

     

       415
       415
       -
           (prefixed_name, json_value)

     

       416
       416
       -
         

     

       417
       417
       -
         (** Create a reference to all IDs returned by a query method *)

     

       418
       418
       -
         let query_ids ~result_of =

     

       419
       419
       -
           create

     

       420
       420
       -
             ~result_of

     

       421
       421
       -
             ~name:"Foo/query"

     

       422
       422
       -
             ~path:"/ids"

     

       423
       423
       -
         

     

       424
       424
       -
         (** Create a reference to properties of objects returned by a get method *)

     

       425
       425
       -
         let get_property ~result_of ~property =

     

       426
       426
       -
           create

     

       427
       427
       -
             ~result_of

     

       428
       428
       -
             ~name:"Foo/get"

     

       429
       429
       -
             ~path:("/list/*/" ^ property)

     

       430
       430
       -
       end

     

       431
       431
       -
       

     

       432
       432
       -
       module Api = struct

     

       433
       433
       -
         open Lwt.Syntax

     

       434
       434
       -
         open Types

     

       435
       435
       -
       

     

       436
       436
       -
         (** Error that may occur during API requests *)

     

       437
       437
       -
         type error =

     

       438
       438
       -
           | Connection_error of string

     

       439
       439
       -
           | HTTP_error of int * string

     

       440
       440
       -
           | Parse_error of string

     

       441
       441
       -
           | Authentication_error

     

       442
       442
       -
       

     

       443
       443
       -
         (** Result type for API operations *)

     

       444
       444
       -
         type 'a result = ('a, error) Stdlib.result

     

       445
       445
       -
       

     

       446
       446
       -
         (** Configuration for a JMAP API client *)

     

       447
       447
       -
         type config = {

     

       448
       448
       -
           api_uri: Uri.t;

     

       449
       449
       -
           username: string;

     

       450
       450
       -
           authentication_token: string;

     

       451
       451
       -
         }

     

       452
       452
       -
       

     

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

     

       454
       454
       -
         let json_to_string json =

     

       455
       455
       -
           Ezjsonm.value_to_string ~minify:false json

     

       456
       456
       -
       

     

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

     

       458
       458
       -
         let parse_json_string str =

     

       459
       459
       -
           try Ok (Ezjsonm.from_string str)

     

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

     

       461
       461
       -
       

     

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

     

       463
       463
       -
         let parse_response json =

     

       464
       464
       -
           try

     

       465
       465
       -
             let method_responses =

     

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

     

       467
       467
       -
               | `A items ->

     

       468
       468
       -
                   List.map (fun json ->

     

       469
       469
       -
                     match json with

     

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

     

       471
       471
       -
                         { name; arguments = args; method_call_id }

     

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

     

       473
       473
       -
                   ) items

     

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

     

       475
       475
       -
             in

     

       476
       476
       -
             let created_ids_opt =

     

       477
       477
       -
               try

     

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

     

       479
       479
       -
                 match obj with

     

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

     

       481
       481
       -
                     match v with

     

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

     

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

     

       484
       484
       -
                   ) items)

     

       485
       485
       -
                 | _ -> None

     

       486
       486
       -
               with Not_found -> None

     

       487
       487
       -
             in

     

       488
       488
       -
             let session_state =

     

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

     

       490
       490
       -
               | `String s -> s

     

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

     

       492
       492
       -
             in

     

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

     

       494
       494
       -
           with

     

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

     

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

     

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

     

       498
       498
       -
       

     

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

     

       500
       500
       -
         let serialize_request req =

     

       501
       501
       -
           let method_calls_json =

     

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

     

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

     

       504
       504
       -
             ) req.method_calls)

     

       505
       505
       -
           in

     

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

     

       507
       507
       -
           let json = `O [

     

       508
       508
       -
             ("using", using_json);

     

       509
       509
       -
             ("methodCalls", method_calls_json)

     

       510
       510
       -
           ] in

     

       511
       511
       -
           let json = match req.created_ids with

     

       512
       512
       -
             | Some ids ->

     

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

     

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

     

       515
       515
       -
             | None -> json

     

       516
       516
       -
           in

     

       517
       517
       -
           json_to_string json

     

       518
       518
       -
       

     

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

     

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

     

       521
       521
       -
           let open Cohttp in

     

       522
       522
       -
           let open Cohttp_lwt_unix in

     

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

     

       524
       524
       -
           

     

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

     

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

     

       527
       527
       -
           let redacted_headers = redact_headers header_list in

     

       528
       528
       -
           Logs.debug (fun m -> 

     

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

     

       530
       530
       -
                URI: %s\n\

     

       531
       531
       -
                METHOD: %s\n\

     

       532
       532
       -
                HEADERS:\n%s\n\

     

       533
       533
       -
                BODY:\n%s\n\

     

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

     

       535
       535
       -
               (Uri.to_string uri)

     

       536
       536
       -
               method_

     

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

     

       538
       538
       -
               body);

     

       539
       539
       -
           

     

       540
       540
       -
           Lwt.catch

     

       541
       541
       -
             (fun () ->

     

       542
       542
       -
               let* resp, body = 

     

       543
       543
       -
                 match method_ with

     

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

     

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

     

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

     

       547
       547
       -
               in

     

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

     

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

     

       550
       550
       -
               

     

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

     

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

     

       553
       553
       -
               let redacted_headers = redact_headers header_list in

     

       554
       554
       -
               Logs.debug (fun m -> 

     

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

     

       556
       556
       -
                    STATUS: %d\n\

     

       557
       557
       -
                    HEADERS:\n%s\n\

     

       558
       558
       -
                    BODY:\n%s\n\

     

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

     

       560
       560
       -
                   status

     

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

     

       562
       562
       -
                   body_str);

     

       563
       563
       -
               

     

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

     

       565
       565
       -
                 Lwt.return (Ok body_str)

     

       566
       566
       -
               else

     

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

     

       568
       568
       -
             (fun e -> 

     

       569
       569
       -
               let error_msg = Printexc.to_string e in

     

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

     

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

     

       572
       572
       -
       

     

       573
       573
       -
         (** Make a raw JMAP API request 

     

       574
       574
       -
             

     

       575
       575
       -
             TODO:claude *)

     

       576
       576
       -
         let make_request config req =

     

       577
       577
       -
           let body = serialize_request req in

     

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

     

       579
       579
       -
           let auth_header = 

     

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

     

       581
       581
       -
               (* Standard username/password authentication *)

     

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

     

       583
       583
       -
             else

     

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

     

       585
       585
       -
               "Bearer " ^ config.authentication_token

     

       586
       586
       -
           in

     

       587
       587
       -
           

     

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

     

       589
       589
       -
           let redacted_header =

     

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

     

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

     

       592
       592
       -
             else

     

       593
       593
       -
               "Bearer " ^ redact_token config.authentication_token

     

       594
       594
       -
           in

     

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

     

       596
       596
       -
           

     

       597
       597
       -
           let headers = [

     

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

     

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

     

       600
       600
       -
             ("Authorization", auth_header)

     

       601
       601
       -
           ] in

     

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

     

       603
       603
       -
           match result with

     

       604
       604
       -
           | Ok response_body ->

     

       605
       605
       -
               (match parse_json_string response_body with

     

       606
       606
       -
                | Ok json -> 

     

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

     

       608
       608
       -
                    Lwt.return (parse_response json)

     

       609
       609
       -
                | Error e -> 

     

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

     

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

     

       612
       612
       -
                    Lwt.return (Error e))

     

       613
       613
       -
           | Error e -> 

     

       614
       614
       -
               (match e with

     

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

     

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

     

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

     

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

     

       619
       619
       -
               Lwt.return (Error e)

     

       620
       620
       -
       

     

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

     

       622
       622
       -
         let parse_session_object json =

     

       623
       623
       -
           try

     

       624
       624
       -
             let capabilities =

     

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

     

       626
       626
       -
               | `O items -> items

     

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

     

       628
       628
       -
             in

     

       629
       629
       -
             

     

       630
       630
       -
             let accounts =

     

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

     

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

     

       633
       633
       -
                   match json with

     

       634
       634
       -
                   | `O _ -> 

     

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

     

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

     

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

     

       638
       638
       -
                       let account_capabilities =

     

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

     

       640
       640
       -
                         | `O items -> items

     

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

     

       642
       642
       -
                       in

     

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

     

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

     

       645
       645
       -
                 ) items

     

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

     

       647
       647
       -
             in

     

       648
       648
       -
             

     

       649
       649
       -
             let primary_accounts =

     

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

     

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

     

       652
       652
       -
                   match v with

     

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

     

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

     

       655
       655
       -
                 ) items

     

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

     

       657
       657
       -
               | None -> []

     

       658
       658
       -
             in

     

       659
       659
       -
             

     

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

     

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

     

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

     

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

     

       664
       664
       -
             let event_source_url = 

     

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

     

       666
       666
       -
               with Not_found -> None

     

       667
       667
       -
             in

     

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

     

       669
       669
       -
             

     

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

     

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

     

       672
       672
       -
           with

     

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

     

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

     

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

     

       676
       676
       -
       

     

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

     

       678
       678
       -
             

     

       679
       679
       -
             TODO:claude *)

     

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

     

       681
       681
       -
           let headers = 

     

       682
       682
       -
             match (username, authentication_token, api_token) with

     

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

     

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

     

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

     

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

     

       687
       687
       -
                 [

     

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

     

       689
       689
       -
                   ("Authorization", auth)

     

       690
       690
       -
                 ]

     

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

     

       692
       692
       -
                 let auth = "Bearer " ^ token in

     

       693
       693
       -
                 let redacted_token = redact_token token in

     

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

     

       695
       695
       -
                 [

     

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

     

       697
       697
       -
                   ("Authorization", auth)

     

       698
       698
       -
                 ]

     

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

     

       700
       700
       -
           in

     

       701
       701
       -
           

     

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

     

       703
       703
       -
           match result with

     

       704
       704
       -
           | Ok response_body ->

     

       705
       705
       -
               (match parse_json_string response_body with

     

       706
       706
       -
                | Ok json -> 

     

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

     

       708
       708
       -
                    Lwt.return (parse_session_object json)

     

       709
       709
       -
                | Error e -> 

     

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

     

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

     

       712
       712
       -
                    Lwt.return (Error e))

     

       713
       713
       -
           | Error e -> 

     

       714
       714
       -
               let err_msg = match e with

     

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

     

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

     

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

     

       718
       718
       -
                | Authentication_error -> "Authentication error"

     

       719
       719
       -
               in

     

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

     

       721
       721
       -
               Lwt.return (Error e)

     

       722
       722
       -
       

     

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

     

       724
       724
       -
             

     

       725
       725
       -
             TODO:claude *)

     

       726
       726
       -
         let upload_blob config ~account_id ~content_type data =

     

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

     

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

     

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

     

       730
       730
       -
           let upload_uri = Uri.of_string upload_url in

     

       731
       731
       -
           

     

       732
       732
       -
           let headers = [

     

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

     

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

     

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

     

       736
       736
       -
           ] in

     

       737
       737
       -
           

     

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

     

       739
       739
       -
           match result with

     

       740
       740
       -
           | Ok response_body ->

     

       741
       741
       -
               (match parse_json_string response_body with

     

       742
       742
       -
                | Ok json ->

     

       743
       743
       -
                    (try

     

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

     

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

     

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

     

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

     

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

     

       749
       749
       -
                     with

     

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

     

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

     

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

     

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

     

       754
       754
       -
       

     

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

     

       756
       756
       -
             

     

       757
       757
       -
             TODO:claude *)

     

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

     

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

     

       760
       760
       -
           

     

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

     

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

     

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

     

       764
       764
       -
           

     

       765
       765
       -
           let url = match type_ with

     

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

     

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

     

       768
       768
       -
           in

     

       769
       769
       -
           

     

       770
       770
       -
           let url = match name with

     

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

     

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

     

       773
       773
       -
           in

     

       774
       774
       -
           

     

       775
       775
       -
           let download_uri = Uri.of_string url in

     

       776
       776
       -
           

     

       777
       777
       -
           let headers = [

     

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

     

       779
       779
       -
           ] in

     

       780
       780
       -
           

     

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

     

       782
       782
       -
           Lwt.return result

     

       783
       783
       -
       end

-651

lib/jmap.mli

···

       1
       1
       -
       (**

     

       2
       2
       -
        * JMAP protocol implementation based on RFC8620

     

       3
       3
       -
        * https://datatracker.ietf.org/doc/html/rfc8620

     

       4
       4
       -
        *

     

       5
       5
       -
        * This module implements the core JMAP protocol as defined in RFC8620, providing

     

       6
       6
       -
        * types and functions for making JMAP API requests and handling responses.

     

       7
       7
       -
        *)

     

       8
       8
       -
       

     

       9
       9
       -
       (** Initialize and configure logging for JMAP

     

       10
       10
       -
           @param level Optional logging level (higher means more verbose)

     

       11
       11
       -
           @param enable_logs Whether to enable logging at all (default true)

     

       12
       12
       -
           @param redact_sensitive Whether to redact sensitive information like tokens (default true)

     

       13
       13
       -
        *)

     

       14
       14
       -
       val init_logging : ?level:int -> ?enable_logs:bool -> ?redact_sensitive:bool -> unit -> unit

     

       15
       15
       -
       

     

       16
       16
       -
       (** Redact sensitive data like authentication tokens from logs

     

       17
       17
       -
           @param redact Whether to perform redaction (default true)

     

       18
       18
       -
           @param token The token string to redact

     

       19
       19
       -
           @return A redacted version of the token (with characters replaced by '*')

     

       20
       20
       -
        *)

     

       21
       21
       -
       val redact_token : ?redact:bool -> string -> string

     

       22
       22
       -
       

     

       23
       23
       -
       (** Module for managing JMAP capability URIs and other constants 

     

       24
       24
       -
           as defined in RFC8620 Section 1.8

     

       25
       25
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8

     

       26
       26
       -
       *)

     

       27
       27
       -
       module Capability : sig

     

       28
       28
       -
         (** JMAP core capability URI as specified in RFC8620 Section 2

     

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

     

       30
       30
       -
         *)

     

       31
       31
       -
         val core_uri : string

     

       32
       32
       -
       

     

       33
       33
       -
         (** All JMAP capability types as described in RFC8620 Section 1.8

     

       34
       34
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8

     

       35
       35
       -
         *)

     

       36
       36
       -
         type t = 

     

       37
       37
       -
           | Core       (** Core JMAP capability *)

     

       38
       38
       -
           | Extension of string  (** Extension capabilities with custom URIs *)

     

       39
       39
       -
       

     

       40
       40
       -
         (** Convert capability to URI string

     

       41
       41
       -
             @param capability The capability to convert

     

       42
       42
       -
             @return The full URI string for the capability

     

       43
       43
       -
         *)

     

       44
       44
       -
         val to_string : t -> string

     

       45
       45
       -
       

     

       46
       46
       -
         (** Parse a string to a capability, returns Extension for non-core capabilities

     

       47
       47
       -
             @param uri The capability URI string to parse

     

       48
       48
       -
             @return The parsed capability type

     

       49
       49
       -
         *)

     

       50
       50
       -
         val of_string : string -> t

     

       51
       51
       -
           

     

       52
       52
       -
         (** Check if a capability matches the core capability

     

       53
       53
       -
             @param capability The capability to check

     

       54
       54
       -
             @return True if the capability is the core JMAP capability

     

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

     

       56
       56
       -
         *)

     

       57
       57
       -
         val is_core : t -> bool

     

       58
       58
       -
       

     

       59
       59
       -
         (** Check if a capability string is the core capability URI

     

       60
       60
       -
             @param uri The capability URI string to check

     

       61
       61
       -
             @return True if the string represents the core JMAP capability

     

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

     

       63
       63
       -
         *)

     

       64
       64
       -
         val is_core_string : string -> bool

     

       65
       65
       -
       

     

       66
       66
       -
         (** Create a list of capability URI strings

     

       67
       67
       -
             @param capabilities List of capability types

     

       68
       68
       -
             @return List of capability URI strings

     

       69
       69
       -
         *)

     

       70
       70
       -
         val strings_of_capabilities : t list -> string list

     

       71
       71
       -
       end

     

       72
       72
       -
       

     

       73
       73
       -
       (** {1 Types}

     

       74
       74
       -
           Core types as defined in RFC8620

     

       75
       75
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620> RFC8620

     

       76
       76
       -
       *)

     

       77
       77
       -
       

     

       78
       78
       -
       module Types : sig

     

       79
       79
       -
         (** Id string as defined in RFC8620 Section 1.2.

     

       80
       80
       -
             A string of at least 1 and maximum 255 octets, case-sensitive, 

     

       81
       81
       -
             and does not begin with the '#' character.

     

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

     

       83
       83
       -
         *)

     

       84
       84
       -
         type id = string

     

       85
       85
       -
       

     

       86
       86
       -
         (** Int type bounded within the range -2^53+1 to 2^53-1 as defined in RFC8620 Section 1.3.

     

       87
       87
       -
             Represented as JSON number where the value MUST be an integer and in the range.

     

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

     

       89
       89
       -
         *)

     

       90
       90
       -
         type int_t = int

     

       91
       91
       -
       

     

       92
       92
       -
         (** UnsignedInt bounded within the range 0 to 2^53-1 as defined in RFC8620 Section 1.3.

     

       93
       93
       -
             Represented as JSON number where the value MUST be a non-negative integer and in the range.

     

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

     

       95
       95
       -
         *)

     

       96
       96
       -
         type unsigned_int = int

     

       97
       97
       -
       

     

       98
       98
       -
         (** Date string in RFC3339 format as defined in RFC8620 Section 1.4.

     

       99
       99
       -
             Includes date, time and time zone offset information or UTC.

     

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

     

       101
       101
       -
         *)

     

       102
       102
       -
         type date = string

     

       103
       103
       -
       

     

       104
       104
       -
         (** UTCDate is a Date with 'Z' time zone (UTC) as defined in RFC8620 Section 1.4.

     

       105
       105
       -
             Same format as Date type but always with UTC time zone (Z).

     

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

     

       107
       107
       -
         *)

     

       108
       108
       -
         type utc_date = string

     

       109
       109
       -
       

     

       110
       110
       -
         (** Error object as defined in RFC8620 Section 3.6.2.

     

       111
       111
       -
             Used to represent standard error conditions in method responses.

     

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

     

       113
       113
       -
         *)

     

       114
       114
       -
         type error = {

     

       115
       115
       -
           type_: string;  (** The type of error, e.g., "serverFail" *)

     

       116
       116
       -
           description: string option;  (** Optional human-readable description of the error *)

     

       117
       117
       -
         }

     

       118
       118
       -
       

     

       119
       119
       -
         (** Set error object as defined in RFC8620 Section 5.3.

     

       120
       120
       -
             Used for reporting errors in set operations.

     

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

     

       122
       122
       -
         *)

     

       123
       123
       -
         type set_error = {

     

       124
       124
       -
           type_: string;  (** The type of error, e.g., "notFound" *)

     

       125
       125
       -
           description: string option;  (** Optional human-readable description of the error *)

     

       126
       126
       -
           properties: string list option;  (** Properties causing the error, if applicable *)

     

       127
       127
       -
           existing_id: id option;  (** For "alreadyExists" error, the ID of the existing object *)

     

       128
       128
       -
         }

     

       129
       129
       -
       

     

       130
       130
       -
         (** Invocation object as defined in RFC8620 Section 3.2.

     

       131
       131
       -
             Represents a method call in the JMAP protocol.

     

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

     

       133
       133
       -
         *)

     

       134
       134
       -
         type 'a invocation = {

     

       135
       135
       -
           name: string;  (** The name of the method to call, e.g., "Mailbox/get" *)

     

       136
       136
       -
           arguments: 'a;  (** The arguments for the method, type varies by method *)

     

       137
       137
       -
           method_call_id: string;  (** Client-specified ID for referencing this call *)

     

       138
       138
       -
         }

     

       139
       139
       -
       

     

       140
       140
       -
         (** ResultReference object as defined in RFC8620 Section 3.7.

     

       141
       141
       -
             Used to reference results from previous method calls.

     

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

     

       143
       143
       -
         *)

     

       144
       144
       -
         type result_reference = {

     

       145
       145
       -
           result_of: string;  (** The method_call_id of the method to reference *)

     

       146
       146
       -
           name: string;  (** Name of the response in the referenced result *)

     

       147
       147
       -
           path: string;  (** JSON pointer path to the value being referenced *)

     

       148
       148
       -
         }

     

       149
       149
       -
       

     

       150
       150
       -
         (** FilterOperator, FilterCondition and Filter as defined in RFC8620 Section 5.5.

     

       151
       151
       -
             Used for complex filtering in query methods.

     

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

     

       153
       153
       -
         *)

     

       154
       154
       -
         type filter_operator = {

     

       155
       155
       -
           operator: string;  (** The operator: "AND", "OR", "NOT" *)

     

       156
       156
       -
           conditions: filter list;  (** The conditions to apply the operator to *)

     

       157
       157
       -
         }

     

       158
       158
       -
        

     

       159
       159
       -
         (** Property/value pairs for filtering *)

     

       160
       160
       -
         and filter_condition =

     

       161
       161
       -
           (string * Ezjsonm.value) list 

     

       162
       162
       -
       

     

       163
       163
       -
         and filter = 

     

       164
       164
       -
           | Operator of filter_operator  (** Logical operator combining conditions *)

     

       165
       165
       -
           | Condition of filter_condition  (** Simple property-based condition *)

     

       166
       166
       -
       

     

       167
       167
       -
         (** Comparator object for sorting as defined in RFC8620 Section 5.5.

     

       168
       168
       -
             Specifies how to sort query results.

     

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

     

       170
       170
       -
         *)

     

       171
       171
       -
         type comparator = {

     

       172
       172
       -
           property: string;  (** The property to sort by *)

     

       173
       173
       -
           is_ascending: bool option;  (** Sort order (true for ascending, false for descending) *)

     

       174
       174
       -
           collation: string option;  (** Collation algorithm for string comparison *)

     

       175
       175
       -
         }

     

       176
       176
       -
       

     

       177
       177
       -
         (** PatchObject as defined in RFC8620 Section 5.3.

     

       178
       178
       -
             Used to represent a set of updates to apply to an object.

     

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

     

       180
       180
       -
         *)

     

       181
       181
       -
         type patch_object = (string * Ezjsonm.value) list  (** List of property/value pairs to update *)

     

       182
       182
       -
       

     

       183
       183
       -
         (** AddedItem structure as defined in RFC8620 Section 5.6.

     

       184
       184
       -
             Represents an item added to a query result.

     

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

     

       186
       186
       -
         *)

     

       187
       187
       -
         type added_item = {

     

       188
       188
       -
           id: id;  (** The ID of the added item *)

     

       189
       189
       -
           index: unsigned_int;  (** The index in the result list where the item appears *)

     

       190
       190
       -
         }

     

       191
       191
       -
       

     

       192
       192
       -
         (** Account object as defined in RFC8620 Section 1.6.2.

     

       193
       193
       -
             Represents a user account in JMAP.

     

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

     

       195
       195
       -
         *)

     

       196
       196
       -
         type account = {

     

       197
       197
       -
           name: string;  (** User-friendly account name, e.g. "john@example.com" *)

     

       198
       198
       -
           is_personal: bool;  (** Whether this account belongs to the authenticated user *)

     

       199
       199
       -
           is_read_only: bool;  (** Whether this account can be modified *)

     

       200
       200
       -
           account_capabilities: (string * Ezjsonm.value) list;  (** Capabilities available for this account *)

     

       201
       201
       -
         }

     

       202
       202
       -
       

     

       203
       203
       -
         (** Core capability object as defined in RFC8620 Section 2.

     

       204
       204
       -
             Describes limits and features of the JMAP server.

     

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

     

       206
       206
       -
         *)

     

       207
       207
       -
         type core_capability = {

     

       208
       208
       -
           max_size_upload: unsigned_int;  (** Maximum file size in octets for uploads *)

     

       209
       209
       -
           max_concurrent_upload: unsigned_int;  (** Maximum number of concurrent uploads *)

     

       210
       210
       -
           max_size_request: unsigned_int;  (** Maximum size in octets for a request *)

     

       211
       211
       -
           max_concurrent_requests: unsigned_int;  (** Maximum number of concurrent requests *)

     

       212
       212
       -
           max_calls_in_request: unsigned_int;  (** Maximum number of method calls in a request *)

     

       213
       213
       -
           max_objects_in_get: unsigned_int;  (** Maximum number of objects in a get request *)

     

       214
       214
       -
           max_objects_in_set: unsigned_int;  (** Maximum number of objects in a set request *)

     

       215
       215
       -
           collation_algorithms: string list;  (** Supported string collation algorithms *)

     

       216
       216
       -
         }

     

       217
       217
       -
       

     

       218
       218
       -
         (** PushSubscription keys object as defined in RFC8620 Section 7.2.

     

       219
       219
       -
             Contains encryption keys for web push subscriptions.

     

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

     

       221
       221
       -
         *)

     

       222
       222
       -
         type push_keys = {

     

       223
       223
       -
           p256dh: string;  (** User agent public key (Base64url-encoded) *)

     

       224
       224
       -
           auth: string;  (** Authentication secret (Base64url-encoded) *)

     

       225
       225
       -
         }

     

       226
       226
       -
       

     

       227
       227
       -
         (** Session object as defined in RFC8620 Section 2.

     

       228
       228
       -
             Contains information about the server and user's accounts.

     

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

     

       230
       230
       -
         *)

     

       231
       231
       -
         type session = {

     

       232
       232
       -
           capabilities: (string * Ezjsonm.value) list;  (** Server capabilities with their properties *)

     

       233
       233
       -
           accounts: (id * account) list;  (** Map of account IDs to account objects *)

     

       234
       234
       -
           primary_accounts: (string * id) list;  (** Map of capability URIs to primary account IDs *)

     

       235
       235
       -
           username: string;  (** Username associated with this session *)

     

       236
       236
       -
           api_url: string;  (** URL to use for JMAP API requests *)

     

       237
       237
       -
           download_url: string;  (** URL endpoint to download files *)

     

       238
       238
       -
           upload_url: string;  (** URL endpoint to upload files *)

     

       239
       239
       -
           event_source_url: string option;  (** URL for Server-Sent Events notifications *)

     

       240
       240
       -
           state: string;  (** String representing the state on the server *)

     

       241
       241
       -
         }

     

       242
       242
       -
       

     

       243
       243
       -
         (** TypeState for state changes as defined in RFC8620 Section 7.1.

     

       244
       244
       -
             Maps data type names to the state string for that type.

     

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

     

       246
       246
       -
         *)

     

       247
       247
       -
         type type_state = (string * string) list  (** (data type name, state string) pairs *)

     

       248
       248
       -
       

     

       249
       249
       -
         (** StateChange object as defined in RFC8620 Section 7.1.

     

       250
       250
       -
             Represents changes to data types for different accounts.

     

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

     

       252
       252
       -
         *)

     

       253
       253
       -
         type state_change = {

     

       254
       254
       -
           changed: (id * type_state) list;  (** Map of account IDs to type state changes *)

     

       255
       255
       -
         }

     

       256
       256
       -
       

     

       257
       257
       -
         (** PushVerification object as defined in RFC8620 Section 7.2.2.

     

       258
       258
       -
             Used for verifying push subscription ownership.

     

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

     

       260
       260
       -
         *)

     

       261
       261
       -
         type push_verification = {

     

       262
       262
       -
           push_subscription_id: id;  (** ID of the push subscription being verified *)

     

       263
       263
       -
           verification_code: string;  (** Code the client must submit to verify ownership *)

     

       264
       264
       -
         }

     

       265
       265
       -
       

     

       266
       266
       -
         (** PushSubscription object as defined in RFC8620 Section 7.2.

     

       267
       267
       -
             Represents a subscription for push notifications.

     

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

     

       269
       269
       -
         *)

     

       270
       270
       -
         type push_subscription = {

     

       271
       271
       -
           id: id;  (** Server-assigned ID for the subscription *)

     

       272
       272
       -
           device_client_id: string;  (** ID representing the client/device *)

     

       273
       273
       -
           url: string;  (** URL to which events are pushed *)

     

       274
       274
       -
           keys: push_keys option;  (** Encryption keys for web push, if any *)

     

       275
       275
       -
           verification_code: string option;  (** Verification code if not yet verified *)

     

       276
       276
       -
           expires: utc_date option;  (** When the subscription expires, if applicable *)

     

       277
       277
       -
           types: string list option;  (** Types of changes to push, null means all *)

     

       278
       278
       -
         }

     

       279
       279
       -
       

     

       280
       280
       -
         (** Request object as defined in RFC8620 Section 3.3.

     

       281
       281
       -
             Represents a JMAP request from client to server.

     

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

     

       283
       283
       -
         *)

     

       284
       284
       -
         type request = {

     

       285
       285
       -
           using: string list;  (** Capabilities required for this request *)

     

       286
       286
       -
           method_calls: Ezjsonm.value invocation list;  (** List of method calls to process *)

     

       287
       287
       -
           created_ids: (id * id) list option;  (** Map of client-created IDs to server IDs *)

     

       288
       288
       -
         }

     

       289
       289
       -
       

     

       290
       290
       -
         (** Response object as defined in RFC8620 Section 3.4.

     

       291
       291
       -
             Represents a JMAP response from server to client.

     

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

     

       293
       293
       -
         *)

     

       294
       294
       -
         type response = {

     

       295
       295
       -
           method_responses: Ezjsonm.value invocation list;  (** List of method responses *)

     

       296
       296
       -
           created_ids: (id * id) list option;  (** Map of client-created IDs to server IDs *)

     

       297
       297
       -
           session_state: string;  (** Current session state on the server *)

     

       298
       298
       -
         }

     

       299
       299
       -
       

     

       300
       300
       -
         (** {2 Standard method arguments and responses}

     

       301
       301
       -
             Standard method patterns defined in RFC8620 Section 5

     

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

     

       303
       303
       -
         *)

     

       304
       304
       -
       

     

       305
       305
       -
         (** Arguments for Foo/get method as defined in RFC8620 Section 5.1.

     

       306
       306
       -
             Generic template for retrieving objects by ID.

     

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

     

       308
       308
       -
         *)

     

       309
       309
       -
         type 'a get_arguments = {

     

       310
       310
       -
           account_id: id;  (** The account ID to operate on *)

     

       311
       311
       -
           ids: id list option;  (** IDs to fetch, null means all *)

     

       312
       312
       -
           properties: string list option;  (** Properties to return, null means all *)

     

       313
       313
       -
         }

     

       314
       314
       -
       

     

       315
       315
       -
         (** Response for Foo/get method as defined in RFC8620 Section 5.1.

     

       316
       316
       -
             Generic template for returning requested objects.

     

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

     

       318
       318
       -
         *)

     

       319
       319
       -
         type 'a get_response = {

     

       320
       320
       -
           account_id: id;  (** The account ID that was operated on *)

     

       321
       321
       -
           state: string;  (** Server state for the type at the time of processing *)

     

       322
       322
       -
           list: 'a list;  (** The list of requested objects *)

     

       323
       323
       -
           not_found: id list;  (** IDs that could not be found *)

     

       324
       324
       -
         }

     

       325
       325
       -
       

     

       326
       326
       -
         (** Arguments for Foo/changes method as defined in RFC8620 Section 5.2.

     

       327
       327
       -
             Generic template for getting state changes.

     

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

     

       329
       329
       -
         *)

     

       330
       330
       -
         type changes_arguments = {

     

       331
       331
       -
           account_id: id;  (** The account ID to operate on *)

     

       332
       332
       -
           since_state: string;  (** The last state seen by the client *)

     

       333
       333
       -
           max_changes: unsigned_int option;  (** Maximum number of changes to return *)

     

       334
       334
       -
         }

     

       335
       335
       -
       

     

       336
       336
       -
         (** Response for Foo/changes method as defined in RFC8620 Section 5.2.

     

       337
       337
       -
             Generic template for returning object changes.

     

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

     

       339
       339
       -
         *)

     

       340
       340
       -
         type changes_response = {

     

       341
       341
       -
           account_id: id;  (** The account ID that was operated on *)

     

       342
       342
       -
           old_state: string;  (** The state provided in the request *)

     

       343
       343
       -
           new_state: string;  (** The current server state *)

     

       344
       344
       -
           has_more_changes: bool;  (** True if more changes are available *)

     

       345
       345
       -
           created: id list;  (** IDs of objects created since old_state *)

     

       346
       346
       -
           updated: id list;  (** IDs of objects updated since old_state *)

     

       347
       347
       -
           destroyed: id list;  (** IDs of objects destroyed since old_state *)

     

       348
       348
       -
         }

     

       349
       349
       -
       

     

       350
       350
       -
         (** Arguments for Foo/set method as defined in RFC8620 Section 5.3.

     

       351
       351
       -
             Generic template for creating, updating, and destroying objects.

     

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

     

       353
       353
       -
         *)

     

       354
       354
       -
         type 'a set_arguments = {

     

       355
       355
       -
           account_id: id;  (** The account ID to operate on *)

     

       356
       356
       -
           if_in_state: string option;  (** Only apply changes if in this state *)

     

       357
       357
       -
           create: (id * 'a) list option;  (** Map of creation IDs to objects to create *)

     

       358
       358
       -
           update: (id * patch_object) list option;  (** Map of IDs to patches to apply *)

     

       359
       359
       -
           destroy: id list option;  (** List of IDs to destroy *)

     

       360
       360
       -
         }

     

       361
       361
       -
       

     

       362
       362
       -
         (** Response for Foo/set method as defined in RFC8620 Section 5.3.

     

       363
       363
       -
             Generic template for reporting create/update/destroy status.

     

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

     

       365
       365
       -
         *)

     

       366
       366
       -
         type 'a set_response = {

     

       367
       367
       -
           account_id: id;  (** The account ID that was operated on *)

     

       368
       368
       -
           old_state: string option;  (** The state before processing, if changed *)

     

       369
       369
       -
           new_state: string;  (** The current server state *)

     

       370
       370
       -
           created: (id * 'a) list option;  (** Map of creation IDs to created objects *)

     

       371
       371
       -
           updated: (id * 'a option) list option;  (** Map of IDs to updated objects *)

     

       372
       372
       -
           destroyed: id list option;  (** List of IDs successfully destroyed *)

     

       373
       373
       -
           not_created: (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       374
       374
       -
           not_updated: (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       375
       375
       -
           not_destroyed: (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       376
       376
       -
         }

     

       377
       377
       -
       

     

       378
       378
       -
         (** Arguments for Foo/copy method as defined in RFC8620 Section 5.4.

     

       379
       379
       -
             Generic template for copying objects between accounts.

     

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

     

       381
       381
       -
         *)

     

       382
       382
       -
         type 'a copy_arguments = {

     

       383
       383
       -
           from_account_id: id;  (** The account ID to copy from *)

     

       384
       384
       -
           if_from_in_state: string option;  (** Only copy if source account in this state *)

     

       385
       385
       -
           account_id: id;  (** The account ID to copy to *)

     

       386
       386
       -
           if_in_state: string option;  (** Only copy if destination account in this state *)

     

       387
       387
       -
           create: (id * 'a) list;  (** Map of creation IDs to objects to copy *)

     

       388
       388
       -
           on_success_destroy_original: bool option;  (** Whether to destroy the original after copying *)

     

       389
       389
       -
           destroy_from_if_in_state: string option;  (** Only destroy originals if in this state *)

     

       390
       390
       -
         }

     

       391
       391
       -
       

     

       392
       392
       -
         (** Response for Foo/copy method as defined in RFC8620 Section 5.4.

     

       393
       393
       -
             Generic template for reporting copy operation status.

     

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

     

       395
       395
       -
         *)

     

       396
       396
       -
         type 'a copy_response = {

     

       397
       397
       -
           from_account_id: id;  (** The account ID that was copied from *)

     

       398
       398
       -
           account_id: id;  (** The account ID that was copied to *)

     

       399
       399
       -
           old_state: string option;  (** The state before processing, if changed *)

     

       400
       400
       -
           new_state: string;  (** The current server state *)

     

       401
       401
       -
           created: (id * 'a) list option;  (** Map of creation IDs to created objects *)

     

       402
       402
       -
           not_created: (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       403
       403
       -
         }

     

       404
       404
       -
       

     

       405
       405
       -
         (** Arguments for Foo/query method as defined in RFC8620 Section 5.5.

     

       406
       406
       -
             Generic template for querying objects.

     

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

     

       408
       408
       -
         *)

     

       409
       409
       -
         type query_arguments = {

     

       410
       410
       -
           account_id: id;  (** The account ID to operate on *)

     

       411
       411
       -
           filter: filter option;  (** Filter to determine which objects are returned *)

     

       412
       412
       -
           sort: comparator list option;  (** Sort order for returned objects *)

     

       413
       413
       -
           position: int_t option;  (** Zero-based index of first result to return *)

     

       414
       414
       -
           anchor: id option;  (** ID of object to use as reference point *)

     

       415
       415
       -
           anchor_offset: int_t option;  (** Offset from anchor to start returning results *)

     

       416
       416
       -
           limit: unsigned_int option;  (** Maximum number of results to return *)

     

       417
       417
       -
           calculate_total: bool option;  (** Whether to calculate the total number of matching objects *)

     

       418
       418
       -
         }

     

       419
       419
       -
       

     

       420
       420
       -
         (** Response for Foo/query method as defined in RFC8620 Section 5.5.

     

       421
       421
       -
             Generic template for returning query results.

     

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

     

       423
       423
       -
         *)

     

       424
       424
       -
         type query_response = {

     

       425
       425
       -
           account_id: id;  (** The account ID that was operated on *)

     

       426
       426
       -
           query_state: string;  (** State string for the query results *)

     

       427
       427
       -
           can_calculate_changes: bool;  (** Whether queryChanges can be used with these results *)

     

       428
       428
       -
           position: unsigned_int;  (** Zero-based index of the first result *)

     

       429
       429
       -
           ids: id list;  (** The list of IDs for objects matching the query *)

     

       430
       430
       -
           total: unsigned_int option;  (** Total number of matching objects, if calculated *)

     

       431
       431
       -
           limit: unsigned_int option;  (** Limit enforced on the results, if requested *)

     

       432
       432
       -
         }

     

       433
       433
       -
       

     

       434
       434
       -
         (** Arguments for Foo/queryChanges method as defined in RFC8620 Section 5.6.

     

       435
       435
       -
             Generic template for getting query result changes.

     

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

     

       437
       437
       -
         *)

     

       438
       438
       -
         type query_changes_arguments = {

     

       439
       439
       -
           account_id: id;  (** The account ID to operate on *)

     

       440
       440
       -
           filter: filter option;  (** Same filter as used in the original query *)

     

       441
       441
       -
           sort: comparator list option;  (** Same sort as used in the original query *)

     

       442
       442
       -
           since_query_state: string;  (** The query_state from previous results *)

     

       443
       443
       -
           max_changes: unsigned_int option;  (** Maximum number of changes to return *)

     

       444
       444
       -
           up_to_id: id option;  (** Only calculate changes until this ID is encountered *)

     

       445
       445
       -
           calculate_total: bool option;  (** Whether to recalculate the total matches *)

     

       446
       446
       -
         }

     

       447
       447
       -
       

     

       448
       448
       -
         (** Response for Foo/queryChanges method as defined in RFC8620 Section 5.6.

     

       449
       449
       -
             Generic template for returning query result changes.

     

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

     

       451
       451
       -
         *)

     

       452
       452
       -
         type query_changes_response = {

     

       453
       453
       -
           account_id: id;  (** The account ID that was operated on *)

     

       454
       454
       -
           old_query_state: string;  (** The query_state from the request *)

     

       455
       455
       -
           new_query_state: string;  (** The current query_state on the server *)

     

       456
       456
       -
           total: unsigned_int option;  (** Updated total number of matches, if calculated *)

     

       457
       457
       -
           removed: id list;  (** IDs that were in the old results but not in the new *)

     

       458
       458
       -
           added: added_item list option;  (** IDs that are in the new results but not the old *)

     

       459
       459
       -
         }

     

       460
       460
       -
       

     

       461
       461
       -
         (** Arguments for Blob/copy method as defined in RFC8620 Section 6.3.

     

       462
       462
       -
             Used for copying binary data between accounts.

     

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

     

       464
       464
       -
         *)

     

       465
       465
       -
         type blob_copy_arguments = {

     

       466
       466
       -
           from_account_id: id;  (** The account ID to copy blobs from *)

     

       467
       467
       -
           account_id: id;  (** The account ID to copy blobs to *)

     

       468
       468
       -
           blob_ids: id list;  (** IDs of blobs to copy *)

     

       469
       469
       -
         }

     

       470
       470
       -
       

     

       471
       471
       -
         (** Response for Blob/copy method as defined in RFC8620 Section 6.3.

     

       472
       472
       -
             Reports the results of copying binary data.

     

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

     

       474
       474
       -
         *)

     

       475
       475
       -
         type blob_copy_response = {

     

       476
       476
       -
           from_account_id: id;  (** The account ID that was copied from *)

     

       477
       477
       -
           account_id: id;  (** The account ID that was copied to *)

     

       478
       478
       -
           copied: (id * id) list option;  (** Map of source IDs to destination IDs *)

     

       479
       479
       -
           not_copied: (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       480
       480
       -
         }

     

       481
       481
       -
       

     

       482
       482
       -
         (** Upload response as defined in RFC8620 Section 6.1.

     

       483
       483
       -
             Contains information about an uploaded binary blob.

     

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

     

       485
       485
       -
         *)

     

       486
       486
       -
         type upload_response = {

     

       487
       487
       -
           account_id: id;  (** The account ID the blob was uploaded to *)

     

       488
       488
       -
           blob_id: id;  (** The ID for the uploaded blob *)

     

       489
       489
       -
           type_: string;  (** Media type of the blob *)

     

       490
       490
       -
           size: unsigned_int;  (** Size of the blob in octets *)

     

       491
       491
       -
         }

     

       492
       492
       -
       

     

       493
       493
       -
         (** Problem details object as defined in RFC8620 Section 3.6.1 and RFC7807.

     

       494
       494
       -
             Used for HTTP error responses in the JMAP protocol.

     

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

     

       496
       496
       -
             @see <https://datatracker.ietf.org/doc/html/rfc7807>

     

       497
       497
       -
         *)

     

       498
       498
       -
         type problem_details = {

     

       499
       499
       -
           type_: string;  (** URI that identifies the problem type *)

     

       500
       500
       -
           status: int option;  (** HTTP status code for this problem *)

     

       501
       501
       -
           detail: string option;  (** Human-readable explanation of the problem *)

     

       502
       502
       -
           limit: string option;  (** For "limit" errors, which limit was exceeded *)

     

       503
       503
       -
         }

     

       504
       504
       -
       end

     

       505
       505
       -
       

     

       506
       506
       -
       (** {1 API Client}

     

       507
       507
       -
           Modules for interacting with JMAP servers

     

       508
       508
       -
       *)

     

       509
       509
       -
       

     

       510
       510
       -
       (** Module for working with ResultReferences as described in Section 3.7 of RFC8620.

     

       511
       511
       -
           Provides utilities to create and compose results from previous methods.

     

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

     

       513
       513
       -
       *)

     

       514
       514
       -
       module ResultReference : sig

     

       515
       515
       -
         (** Create a reference to a previous method result

     

       516
       516
       -
             @param result_of The methodCallId of the method call to reference

     

       517
       517
       -
             @param name The name in the response to reference (e.g., "list")

     

       518
       518
       -
             @param path JSON pointer path to the value being referenced

     

       519
       519
       -
             @return A result_reference object

     

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

     

       521
       521
       -
         *)

     

       522
       522
       -
         val create : 

     

       523
       523
       -
           result_of:string ->

     

       524
       524
       -
           name:string ->

     

       525
       525
       -
           path:string ->

     

       526
       526
       -
           Types.result_reference

     

       527
       527
       -
       

     

       528
       528
       -
         (** Create a JSON pointer path to access a specific property

     

       529
       529
       -
             @param property The property name to access

     

       530
       530
       -
             @return A JSON pointer path string

     

       531
       531
       -
         *)

     

       532
       532
       -
         val property_path : string -> string

     

       533
       533
       -
         

     

       534
       534
       -
         (** Create a JSON pointer path to access all items in an array with a specific property

     

       535
       535
       -
             @param property Optional property to access within each array item

     

       536
       536
       -
             @param array_name The name of the array to access

     

       537
       537
       -
             @return A JSON pointer path string that references all items in the array

     

       538
       538
       -
         *)

     

       539
       539
       -
         val array_items_path : ?property:string -> string -> string

     

       540
       540
       -
         

     

       541
       541
       -
         (** Create argument with result reference.

     

       542
       542
       -
             @param arg_name The name of the argument

     

       543
       543
       -
             @param reference The result reference to use

     

       544
       544
       -
             @return A tuple of string key (with # prefix) and ResultReference JSON value

     

       545
       545
       -
         *)

     

       546
       546
       -
         val reference_arg : string -> Types.result_reference -> string * Ezjsonm.value

     

       547
       547
       -
         

     

       548
       548
       -
         (** Create a reference to all IDs returned by a query method

     

       549
       549
       -
             @param result_of The methodCallId of the query method call

     

       550
       550
       -
             @return A result_reference to the IDs returned by the query

     

       551
       551
       -
         *)

     

       552
       552
       -
         val query_ids :

     

       553
       553
       -
           result_of:string ->

     

       554
       554
       -
           Types.result_reference

     

       555
       555
       -
           

     

       556
       556
       -
         (** Create a reference to properties of objects returned by a get method

     

       557
       557
       -
             @param result_of The methodCallId of the get method call

     

       558
       558
       -
             @param property The property to reference in the returned objects

     

       559
       559
       -
             @return A result_reference to the specified property in the get results

     

       560
       560
       -
         *)

     

       561
       561
       -
         val get_property :

     

       562
       562
       -
           result_of:string ->

     

       563
       563
       -
           property:string ->

     

       564
       564
       -
           Types.result_reference

     

       565
       565
       -
       end

     

       566
       566
       -
       

     

       567
       567
       -
       (** Module for making JMAP API requests over HTTP.

     

       568
       568
       -
           Provides functionality to interact with JMAP servers according to RFC8620.

     

       569
       569
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620>

     

       570
       570
       -
       *)

     

       571
       571
       -
       module Api : sig

     

       572
       572
       -
         (** Error that may occur during API requests *)

     

       573
       573
       -
         type error =

     

       574
       574
       -
           | Connection_error of string   (** Network-related errors *)

     

       575
       575
       -
           | HTTP_error of int * string   (** HTTP errors with status code and message *)

     

       576
       576
       -
           | Parse_error of string        (** JSON parsing errors *)

     

       577
       577
       -
           | Authentication_error         (** Authentication failures *)

     

       578
       578
       -
         

     

       579
       579
       -
         (** Result type for API operations *)

     

       580
       580
       -
         type 'a result = ('a, error) Stdlib.result

     

       581
       581
       -
         

     

       582
       582
       -
         (** Configuration for a JMAP API client as defined in RFC8620 Section 3.1

     

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

     

       584
       584
       -
         *)

     

       585
       585
       -
         type config = {

     

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

     

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

     

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

     

       589
       589
       -
         }

     

       590
       590
       -
         

     

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

     

       592
       592
       -
             @param config The API client configuration

     

       593
       593
       -
             @param request The JMAP request to send

     

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

     

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

     

       596
       596
       -
         *)

     

       597
       597
       -
         val make_request : 

     

       598
       598
       -
           config -> 

     

       599
       599
       -
           Types.request ->

     

       600
       600
       -
           Types.response result Lwt.t

     

       601
       601
       -
         

     

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

     

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

     

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

     

       605
       605
       -
             @param username Optional username for authentication

     

       606
       606
       -
             @param authentication_token Optional password or token for authentication

     

       607
       607
       -
             @param api_token Optional API token for Bearer authentication

     

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

     

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

     

       610
       610
       -
         *)

     

       611
       611
       -
         val get_session :

     

       612
       612
       -
           Uri.t ->

     

       613
       613
       -
           ?username:string ->

     

       614
       614
       -
           ?authentication_token:string ->

     

       615
       615
       -
           ?api_token:string ->

     

       616
       616
       -
           unit ->

     

       617
       617
       -
           Types.session result Lwt.t

     

       618
       618
       -
         

     

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

     

       620
       620
       -
             @param config The API client configuration

     

       621
       621
       -
             @param account_id The account ID to upload to

     

       622
       622
       -
             @param content_type The MIME type of the blob

     

       623
       623
       -
             @param data The blob data as a string

     

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

     

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

     

       626
       626
       -
         *)

     

       627
       627
       -
         val upload_blob :

     

       628
       628
       -
           config ->

     

       629
       629
       -
           account_id:Types.id ->

     

       630
       630
       -
           content_type:string ->

     

       631
       631
       -
           string ->

     

       632
       632
       -
           Types.upload_response result Lwt.t

     

       633
       633
       -
         

     

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

     

       635
       635
       -
             @param config The API client configuration

     

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

     

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

     

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

     

       639
       639
       -
             @param name Optional name for the downloaded blob

     

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

     

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

     

       642
       642
       -
         *)

     

       643
       643
       -
         val download_blob :

     

       644
       644
       -
           config ->

     

       645
       645
       -
           account_id:Types.id ->

     

       646
       646
       -
           blob_id:Types.id ->

     

       647
       647
       -
           ?type_:string ->

     

       648
       648
       -
           ?name:string ->

     

       649
       649
       -
           unit ->

     

       650
       650
       -
           string result Lwt.t

     

       651
       651
       -
       end

-2014

lib/jmap_mail.ml

···

       1
       1
       -
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 *)

     

       2
       2
       -
       

     

       3
       3
       -
       (** Module for managing JMAP Mail-specific capability URIs *)

     

       4
       4
       -
       module Capability = struct

     

       5
       5
       -
         (** Mail capability URI *)

     

       6
       6
       -
         let mail_uri = "urn:ietf:params:jmap:mail"

     

       7
       7
       -
       

     

       8
       8
       -
         (** Submission capability URI *)

     

       9
       9
       -
         let submission_uri = "urn:ietf:params:jmap:submission"

     

       10
       10
       -
       

     

       11
       11
       -
         (** Vacation response capability URI *)

     

       12
       12
       -
         let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"

     

       13
       13
       -
       

     

       14
       14
       -
         (** All mail extension capability types *)

     

       15
       15
       -
         type t =

     

       16
       16
       -
           | Mail            (** Mail capability *)

     

       17
       17
       -
           | Submission      (** Submission capability *)

     

       18
       18
       -
           | VacationResponse (** Vacation response capability *)

     

       19
       19
       -
           | Extension of string (** Custom extension *)

     

       20
       20
       -
       

     

       21
       21
       -
         (** Convert capability to URI string *)

     

       22
       22
       -
         let to_string = function

     

       23
       23
       -
           | Mail -> mail_uri

     

       24
       24
       -
           | Submission -> submission_uri

     

       25
       25
       -
           | VacationResponse -> vacation_response_uri

     

       26
       26
       -
           | Extension s -> s

     

       27
       27
       -
       

     

       28
       28
       -
         (** Parse a string to a capability *)

     

       29
       29
       -
         let of_string s =

     

       30
       30
       -
           if s = mail_uri then Mail

     

       31
       31
       -
           else if s = submission_uri then Submission

     

       32
       32
       -
           else if s = vacation_response_uri then VacationResponse

     

       33
       33
       -
           else Extension s

     

       34
       34
       -
       

     

       35
       35
       -
         (** Check if a capability is a standard mail capability *)

     

       36
       36
       -
         let is_standard = function

     

       37
       37
       -
           | Mail | Submission | VacationResponse -> true

     

       38
       38
       -
           | Extension _ -> false

     

       39
       39
       -
       

     

       40
       40
       -
         (** Check if a capability string is a standard mail capability *)

     

       41
       41
       -
         let is_standard_string s =

     

       42
       42
       -
           s = mail_uri || s = submission_uri || s = vacation_response_uri

     

       43
       43
       -
       

     

       44
       44
       -
         (** Create a list of capability strings *)

     

       45
       45
       -
         let strings_of_capabilities capabilities =

     

       46
       46
       -
           List.map to_string capabilities

     

       47
       47
       -
       end

     

       48
       48
       -
       

     

       49
       49
       -
       module Types = struct

     

       50
       50
       -
         open Jmap.Types

     

       51
       51
       -
       

     

       52
       52
       -
         (** {1 Mail capabilities} *)

     

       53
       53
       -
       

     

       54
       54
       -
         (** Capability URI for JMAP Mail*)

     

       55
       55
       -
         let capability_mail = Capability.mail_uri

     

       56
       56
       -
       

     

       57
       57
       -
         (** Capability URI for JMAP Submission *)

     

       58
       58
       -
         let capability_submission = Capability.submission_uri

     

       59
       59
       -
         

     

       60
       60
       -
         (** Capability URI for JMAP Vacation Response *)

     

       61
       61
       -
         let capability_vacation_response = Capability.vacation_response_uri

     

       62
       62
       -
       

     

       63
       63
       -
         (** {1:mailbox Mailbox objects} *)

     

       64
       64
       -
       

     

       65
       65
       -
         (** A role for a mailbox. See RFC8621 Section 2. *)

     

       66
       66
       -
         type mailbox_role =

     

       67
       67
       -
           | All (** All mail *)

     

       68
       68
       -
           | Archive (** Archived mail *)

     

       69
       69
       -
           | Drafts (** Draft messages *)

     

       70
       70
       -
           | Flagged (** Starred/flagged mail *)

     

       71
       71
       -
           | Important (** Important mail *)

     

       72
       72
       -
           | Inbox (** Inbox *)

     

       73
       73
       -
           | Junk (** Spam/Junk mail *)

     

       74
       74
       -
           | Sent (** Sent mail *)

     

       75
       75
       -
           | Trash (** Deleted/Trash mail *)

     

       76
       76
       -
           | Unknown of string (** Server-specific roles *)

     

       77
       77
       -
         

     

       78
       78
       -
         (** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)

     

       79
       79
       -
         type mailbox = {

     

       80
       80
       -
           id : id;

     

       81
       81
       -
           name : string;

     

       82
       82
       -
           parent_id : id option;

     

       83
       83
       -
           role : mailbox_role option;

     

       84
       84
       -
           sort_order : unsigned_int;

     

       85
       85
       -
           total_emails : unsigned_int;

     

       86
       86
       -
           unread_emails : unsigned_int;

     

       87
       87
       -
           total_threads : unsigned_int;

     

       88
       88
       -
           unread_threads : unsigned_int;

     

       89
       89
       -
           is_subscribed : bool;

     

       90
       90
       -
           my_rights : mailbox_rights;

     

       91
       91
       -
         }

     

       92
       92
       -
       

     

       93
       93
       -
         (** Rights for a mailbox. See RFC8621 Section 2. *)

     

       94
       94
       -
         and mailbox_rights = {

     

       95
       95
       -
           may_read_items : bool;

     

       96
       96
       -
           may_add_items : bool;

     

       97
       97
       -
           may_remove_items : bool;

     

       98
       98
       -
           may_set_seen : bool;

     

       99
       99
       -
           may_set_keywords : bool;

     

       100
       100
       -
           may_create_child : bool;

     

       101
       101
       -
           may_rename : bool;

     

       102
       102
       -
           may_delete : bool;

     

       103
       103
       -
           may_submit : bool;

     

       104
       104
       -
         }

     

       105
       105
       -
       

     

       106
       106
       -
         (** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)

     

       107
       107
       -
         type mailbox_filter_condition = {

     

       108
       108
       -
           parent_id : id option;

     

       109
       109
       -
           name : string option;

     

       110
       110
       -
           role : string option;

     

       111
       111
       -
           has_any_role : bool option;

     

       112
       112
       -
           is_subscribed : bool option;

     

       113
       113
       -
         }

     

       114
       114
       -
       

     

       115
       115
       -
         type mailbox_query_filter = [

     

       116
       116
       -
           | `And of mailbox_query_filter list

     

       117
       117
       -
           | `Or of mailbox_query_filter list

     

       118
       118
       -
           | `Not of mailbox_query_filter

     

       119
       119
       -
           | `Condition of mailbox_filter_condition

     

       120
       120
       -
         ]

     

       121
       121
       -
       

     

       122
       122
       -
         (** Mailbox/get request arguments. See RFC8621 Section 2.1. *)

     

       123
       123
       -
         type mailbox_get_arguments = {

     

       124
       124
       -
           account_id : id;

     

       125
       125
       -
           ids : id list option;

     

       126
       126
       -
           properties : string list option;

     

       127
       127
       -
         }

     

       128
       128
       -
       

     

       129
       129
       -
         (** Mailbox/get response. See RFC8621 Section 2.1. *)

     

       130
       130
       -
         type mailbox_get_response = {

     

       131
       131
       -
           account_id : id;

     

       132
       132
       -
           state : string;

     

       133
       133
       -
           list : mailbox list;

     

       134
       134
       -
           not_found : id list;

     

       135
       135
       -
         }

     

       136
       136
       -
       

     

       137
       137
       -
         (** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)

     

       138
       138
       -
         type mailbox_changes_arguments = {

     

       139
       139
       -
           account_id : id;

     

       140
       140
       -
           since_state : string;

     

       141
       141
       -
           max_changes : unsigned_int option;

     

       142
       142
       -
         }

     

       143
       143
       -
       

     

       144
       144
       -
         (** Mailbox/changes response. See RFC8621 Section 2.2. *)

     

       145
       145
       -
         type mailbox_changes_response = {

     

       146
       146
       -
           account_id : id;

     

       147
       147
       -
           old_state : string;

     

       148
       148
       -
           new_state : string;

     

       149
       149
       -
           has_more_changes : bool;

     

       150
       150
       -
           created : id list;

     

       151
       151
       -
           updated : id list;

     

       152
       152
       -
           destroyed : id list;

     

       153
       153
       -
         }

     

       154
       154
       -
       

     

       155
       155
       -
         (** Mailbox/query request arguments. See RFC8621 Section 2.3. *)

     

       156
       156
       -
         type mailbox_query_arguments = {

     

       157
       157
       -
           account_id : id;

     

       158
       158
       -
           filter : mailbox_query_filter option;

     

       159
       159
       -
           sort : [ `name | `role | `sort_order ] list option;

     

       160
       160
       -
           limit : unsigned_int option;

     

       161
       161
       -
         }

     

       162
       162
       -
       

     

       163
       163
       -
         (** Mailbox/query response. See RFC8621 Section 2.3. *)

     

       164
       164
       -
         type mailbox_query_response = {

     

       165
       165
       -
           account_id : id;

     

       166
       166
       -
           query_state : string;

     

       167
       167
       -
           can_calculate_changes : bool;

     

       168
       168
       -
           position : unsigned_int;

     

       169
       169
       -
           ids : id list;

     

       170
       170
       -
           total : unsigned_int option;

     

       171
       171
       -
         }

     

       172
       172
       -
       

     

       173
       173
       -
         (** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)

     

       174
       174
       -
         type mailbox_query_changes_arguments = {

     

       175
       175
       -
           account_id : id;

     

       176
       176
       -
           filter : mailbox_query_filter option;

     

       177
       177
       -
           sort : [ `name | `role | `sort_order ] list option;

     

       178
       178
       -
           since_query_state : string;

     

       179
       179
       -
           max_changes : unsigned_int option;

     

       180
       180
       -
           up_to_id : id option;

     

       181
       181
       -
         }

     

       182
       182
       -
       

     

       183
       183
       -
         (** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)

     

       184
       184
       -
         type mailbox_query_changes_response = {

     

       185
       185
       -
           account_id : id;

     

       186
       186
       -
           old_query_state : string;

     

       187
       187
       -
           new_query_state : string;

     

       188
       188
       -
           total : unsigned_int option;

     

       189
       189
       -
           removed : id list;

     

       190
       190
       -
           added : mailbox_query_changes_added list;

     

       191
       191
       -
         }

     

       192
       192
       -
       

     

       193
       193
       -
         and mailbox_query_changes_added = {

     

       194
       194
       -
           id : id;

     

       195
       195
       -
           index : unsigned_int;

     

       196
       196
       -
         }

     

       197
       197
       -
       

     

       198
       198
       -
         (** Mailbox/set request arguments. See RFC8621 Section 2.5. *)

     

       199
       199
       -
         type mailbox_set_arguments = {

     

       200
       200
       -
           account_id : id;

     

       201
       201
       -
           if_in_state : string option;

     

       202
       202
       -
           create : (id * mailbox_creation) list option;

     

       203
       203
       -
           update : (id * mailbox_update) list option;

     

       204
       204
       -
           destroy : id list option;

     

       205
       205
       -
         }

     

       206
       206
       -
       

     

       207
       207
       -
         and mailbox_creation = {

     

       208
       208
       -
           name : string;

     

       209
       209
       -
           parent_id : id option;

     

       210
       210
       -
           role : string option;

     

       211
       211
       -
           sort_order : unsigned_int option;

     

       212
       212
       -
           is_subscribed : bool option;

     

       213
       213
       -
         }

     

       214
       214
       -
       

     

       215
       215
       -
         and mailbox_update = {

     

       216
       216
       -
           name : string option;

     

       217
       217
       -
           parent_id : id option;

     

       218
       218
       -
           role : string option;

     

       219
       219
       -
           sort_order : unsigned_int option;

     

       220
       220
       -
           is_subscribed : bool option;

     

       221
       221
       -
         }

     

       222
       222
       -
       

     

       223
       223
       -
         (** Mailbox/set response. See RFC8621 Section 2.5. *)

     

       224
       224
       -
         type mailbox_set_response = {

     

       225
       225
       -
           account_id : id;

     

       226
       226
       -
           old_state : string option;

     

       227
       227
       -
           new_state : string;

     

       228
       228
       -
           created : (id * mailbox) list option;

     

       229
       229
       -
           updated : id list option;

     

       230
       230
       -
           destroyed : id list option;

     

       231
       231
       -
           not_created : (id * set_error) list option;

     

       232
       232
       -
           not_updated : (id * set_error) list option;

     

       233
       233
       -
           not_destroyed : (id * set_error) list option;

     

       234
       234
       -
         }

     

       235
       235
       -
       

     

       236
       236
       -
         (** {1:thread Thread objects} *)

     

       237
       237
       -
       

     

       238
       238
       -
         (** A thread in a mail account. See RFC8621 Section 3. *)

     

       239
       239
       -
         type thread = {

     

       240
       240
       -
           id : id;

     

       241
       241
       -
           email_ids : id list;

     

       242
       242
       -
         }

     

       243
       243
       -
       

     

       244
       244
       -
         (** Thread/get request arguments. See RFC8621 Section 3.1. *)

     

       245
       245
       -
         type thread_get_arguments = {

     

       246
       246
       -
           account_id : id;

     

       247
       247
       -
           ids : id list option;

     

       248
       248
       -
           properties : string list option;

     

       249
       249
       -
         }

     

       250
       250
       -
       

     

       251
       251
       -
         (** Thread/get response. See RFC8621 Section 3.1. *)

     

       252
       252
       -
         type thread_get_response = {

     

       253
       253
       -
           account_id : id;

     

       254
       254
       -
           state : string;

     

       255
       255
       -
           list : thread list;

     

       256
       256
       -
           not_found : id list;

     

       257
       257
       -
         }

     

       258
       258
       -
       

     

       259
       259
       -
         (** Thread/changes request arguments. See RFC8621 Section 3.2. *)

     

       260
       260
       -
         type thread_changes_arguments = {

     

       261
       261
       -
           account_id : id;

     

       262
       262
       -
           since_state : string;

     

       263
       263
       -
           max_changes : unsigned_int option;

     

       264
       264
       -
         }

     

       265
       265
       -
       

     

       266
       266
       -
         (** Thread/changes response. See RFC8621 Section 3.2. *)

     

       267
       267
       -
         type thread_changes_response = {

     

       268
       268
       -
           account_id : id;

     

       269
       269
       -
           old_state : string;

     

       270
       270
       -
           new_state : string;

     

       271
       271
       -
           has_more_changes : bool;

     

       272
       272
       -
           created : id list;

     

       273
       273
       -
           updated : id list;

     

       274
       274
       -
           destroyed : id list;

     

       275
       275
       -
         }

     

       276
       276
       -
       

     

       277
       277
       -
         (** {1:email Email objects} *)

     

       278
       278
       -
       

     

       279
       279
       -
         (** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)

     

       280
       280
       -
         type email_address = {

     

       281
       281
       -
           name : string option;

     

       282
       282
       -
           email : string;

     

       283
       283
       -
           parameters : (string * string) list;

     

       284
       284
       -
         }

     

       285
       285
       -
       

     

       286
       286
       -
         (** Message header field. See RFC8621 Section 4.1.2. *)

     

       287
       287
       -
         type header = {

     

       288
       288
       -
           name : string;

     

       289
       289
       -
           value : string;

     

       290
       290
       -
         }

     

       291
       291
       -
       

     

       292
       292
       -
         (** Email keyword (flag). See RFC8621 Section 4.3. *)

     

       293
       293
       -
         type keyword =

     

       294
       294
       -
           | Flagged

     

       295
       295
       -
           | Answered

     

       296
       296
       -
           | Draft

     

       297
       297
       -
           | Forwarded

     

       298
       298
       -
           | Phishing

     

       299
       299
       -
           | Junk

     

       300
       300
       -
           | NotJunk

     

       301
       301
       -
           | Seen

     

       302
       302
       -
           | Unread

     

       303
       303
       -
           | Custom of string

     

       304
       304
       -
         

     

       305
       305
       -
         (** Email message. See RFC8621 Section 4. *)

     

       306
       306
       -
         type email = {

     

       307
       307
       -
           id : id;

     

       308
       308
       -
           blob_id : id;

     

       309
       309
       -
           thread_id : id;

     

       310
       310
       -
           mailbox_ids : (id * bool) list;

     

       311
       311
       -
           keywords : (keyword * bool) list;

     

       312
       312
       -
           size : unsigned_int;

     

       313
       313
       -
           received_at : utc_date;

     

       314
       314
       -
           message_id : string list;

     

       315
       315
       -
           in_reply_to : string list option;

     

       316
       316
       -
           references : string list option;

     

       317
       317
       -
           sender : email_address list option;

     

       318
       318
       -
           from : email_address list option;

     

       319
       319
       -
           to_ : email_address list option;

     

       320
       320
       -
           cc : email_address list option;

     

       321
       321
       -
           bcc : email_address list option;

     

       322
       322
       -
           reply_to : email_address list option;

     

       323
       323
       -
           subject : string option;

     

       324
       324
       -
           sent_at : utc_date option;

     

       325
       325
       -
           has_attachment : bool option;

     

       326
       326
       -
           preview : string option;

     

       327
       327
       -
           body_values : (string * string) list option;

     

       328
       328
       -
           text_body : email_body_part list option;

     

       329
       329
       -
           html_body : email_body_part list option;

     

       330
       330
       -
           attachments : email_body_part list option;

     

       331
       331
       -
           headers : header list option;

     

       332
       332
       -
         }

     

       333
       333
       -
       

     

       334
       334
       -
         (** Email body part. See RFC8621 Section 4.1.4. *)

     

       335
       335
       -
         and email_body_part = {

     

       336
       336
       -
           part_id : string option;

     

       337
       337
       -
           blob_id : id option;

     

       338
       338
       -
           size : unsigned_int option;

     

       339
       339
       -
           headers : header list option;

     

       340
       340
       -
           name : string option;

     

       341
       341
       -
           type_ : string option;

     

       342
       342
       -
           charset : string option;

     

       343
       343
       -
           disposition : string option;

     

       344
       344
       -
           cid : string option;

     

       345
       345
       -
           language : string list option;

     

       346
       346
       -
           location : string option;

     

       347
       347
       -
           sub_parts : email_body_part list option;

     

       348
       348
       -
           header_parameter_name : string option;

     

       349
       349
       -
           header_parameter_value : string option;

     

       350
       350
       -
         }

     

       351
       351
       -
         

     

       352
       352
       -
         (** Email query filter condition. See RFC8621 Section 4.4. *)

     

       353
       353
       -
         type email_filter_condition = {

     

       354
       354
       -
           in_mailbox : id option;

     

       355
       355
       -
           in_mailbox_other_than : id list option;

     

       356
       356
       -
           min_size : unsigned_int option;

     

       357
       357
       -
           max_size : unsigned_int option;

     

       358
       358
       -
           before : utc_date option;

     

       359
       359
       -
           after : utc_date option;

     

       360
       360
       -
           header : (string * string) option;

     

       361
       361
       -
           from : string option;

     

       362
       362
       -
           to_ : string option;

     

       363
       363
       -
           cc : string option;

     

       364
       364
       -
           bcc : string option;

     

       365
       365
       -
           subject : string option;

     

       366
       366
       -
           body : string option;

     

       367
       367
       -
           has_keyword : string option;

     

       368
       368
       -
           not_keyword : string option;

     

       369
       369
       -
           has_attachment : bool option;

     

       370
       370
       -
           text : string option;

     

       371
       371
       -
         }

     

       372
       372
       -
       

     

       373
       373
       -
         type email_query_filter = [

     

       374
       374
       -
           | `And of email_query_filter list

     

       375
       375
       -
           | `Or of email_query_filter list

     

       376
       376
       -
           | `Not of email_query_filter

     

       377
       377
       -
           | `Condition of email_filter_condition

     

       378
       378
       -
         ]

     

       379
       379
       -
       

     

       380
       380
       -
         (** Email/get request arguments. See RFC8621 Section 4.5. *)

     

       381
       381
       -
         type email_get_arguments = {

     

       382
       382
       -
           account_id : id;

     

       383
       383
       -
           ids : id list option;

     

       384
       384
       -
           properties : string list option;

     

       385
       385
       -
           body_properties : string list option;

     

       386
       386
       -
           fetch_text_body_values : bool option;

     

       387
       387
       -
           fetch_html_body_values : bool option;

     

       388
       388
       -
           fetch_all_body_values : bool option;

     

       389
       389
       -
           max_body_value_bytes : unsigned_int option;

     

       390
       390
       -
         }

     

       391
       391
       -
       

     

       392
       392
       -
         (** Email/get response. See RFC8621 Section 4.5. *)

     

       393
       393
       -
         type email_get_response = {

     

       394
       394
       -
           account_id : id;

     

       395
       395
       -
           state : string;

     

       396
       396
       -
           list : email list;

     

       397
       397
       -
           not_found : id list;

     

       398
       398
       -
         }

     

       399
       399
       -
       

     

       400
       400
       -
         (** Email/changes request arguments. See RFC8621 Section 4.6. *)

     

       401
       401
       -
         type email_changes_arguments = {

     

       402
       402
       -
           account_id : id;

     

       403
       403
       -
           since_state : string;

     

       404
       404
       -
           max_changes : unsigned_int option;

     

       405
       405
       -
         }

     

       406
       406
       -
       

     

       407
       407
       -
         (** Email/changes response. See RFC8621 Section 4.6. *)

     

       408
       408
       -
         type email_changes_response = {

     

       409
       409
       -
           account_id : id;

     

       410
       410
       -
           old_state : string;

     

       411
       411
       -
           new_state : string;

     

       412
       412
       -
           has_more_changes : bool;

     

       413
       413
       -
           created : id list;

     

       414
       414
       -
           updated : id list;

     

       415
       415
       -
           destroyed : id list;

     

       416
       416
       -
         }

     

       417
       417
       -
       

     

       418
       418
       -
         (** Email/query request arguments. See RFC8621 Section 4.4. *)

     

       419
       419
       -
         type email_query_arguments = {

     

       420
       420
       -
           account_id : id;

     

       421
       421
       -
           filter : email_query_filter option;

     

       422
       422
       -
           sort : comparator list option;

     

       423
       423
       -
           collapse_threads : bool option;

     

       424
       424
       -
           position : unsigned_int option;

     

       425
       425
       -
           anchor : id option;

     

       426
       426
       -
           anchor_offset : int_t option;

     

       427
       427
       -
           limit : unsigned_int option;

     

       428
       428
       -
           calculate_total : bool option;

     

       429
       429
       -
         }

     

       430
       430
       -
       

     

       431
       431
       -
         (** Email/query response. See RFC8621 Section 4.4. *)

     

       432
       432
       -
         type email_query_response = {

     

       433
       433
       -
           account_id : id;

     

       434
       434
       -
           query_state : string;

     

       435
       435
       -
           can_calculate_changes : bool;

     

       436
       436
       -
           position : unsigned_int;

     

       437
       437
       -
           ids : id list;

     

       438
       438
       -
           total : unsigned_int option;

     

       439
       439
       -
           thread_ids : id list option;

     

       440
       440
       -
         }

     

       441
       441
       -
       

     

       442
       442
       -
         (** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)

     

       443
       443
       -
         type email_query_changes_arguments = {

     

       444
       444
       -
           account_id : id;

     

       445
       445
       -
           filter : email_query_filter option;

     

       446
       446
       -
           sort : comparator list option;

     

       447
       447
       -
           collapse_threads : bool option;

     

       448
       448
       -
           since_query_state : string;

     

       449
       449
       -
           max_changes : unsigned_int option;

     

       450
       450
       -
           up_to_id : id option;

     

       451
       451
       -
         }

     

       452
       452
       -
       

     

       453
       453
       -
         (** Email/queryChanges response. See RFC8621 Section 4.7. *)

     

       454
       454
       -
         type email_query_changes_response = {

     

       455
       455
       -
           account_id : id;

     

       456
       456
       -
           old_query_state : string;

     

       457
       457
       -
           new_query_state : string;

     

       458
       458
       -
           total : unsigned_int option;

     

       459
       459
       -
           removed : id list;

     

       460
       460
       -
           added : email_query_changes_added list;

     

       461
       461
       -
         }

     

       462
       462
       -
       

     

       463
       463
       -
         and email_query_changes_added = {

     

       464
       464
       -
           id : id;

     

       465
       465
       -
           index : unsigned_int;

     

       466
       466
       -
         }

     

       467
       467
       -
       

     

       468
       468
       -
         (** Email/set request arguments. See RFC8621 Section 4.8. *)

     

       469
       469
       -
         type email_set_arguments = {

     

       470
       470
       -
           account_id : id;

     

       471
       471
       -
           if_in_state : string option;

     

       472
       472
       -
           create : (id * email_creation) list option;

     

       473
       473
       -
           update : (id * email_update) list option;

     

       474
       474
       -
           destroy : id list option;

     

       475
       475
       -
         }

     

       476
       476
       -
       

     

       477
       477
       -
         and email_creation = {

     

       478
       478
       -
           mailbox_ids : (id * bool) list;

     

       479
       479
       -
           keywords : (keyword * bool) list option;

     

       480
       480
       -
           received_at : utc_date option;

     

       481
       481
       -
           message_id : string list option;

     

       482
       482
       -
           in_reply_to : string list option;

     

       483
       483
       -
           references : string list option;

     

       484
       484
       -
           sender : email_address list option;

     

       485
       485
       -
           from : email_address list option;

     

       486
       486
       -
           to_ : email_address list option;

     

       487
       487
       -
           cc : email_address list option;

     

       488
       488
       -
           bcc : email_address list option;

     

       489
       489
       -
           reply_to : email_address list option;

     

       490
       490
       -
           subject : string option;

     

       491
       491
       -
           body_values : (string * string) list option;

     

       492
       492
       -
           text_body : email_body_part list option;

     

       493
       493
       -
           html_body : email_body_part list option;

     

       494
       494
       -
           attachments : email_body_part list option;

     

       495
       495
       -
           headers : header list option;

     

       496
       496
       -
         }

     

       497
       497
       -
       

     

       498
       498
       -
         and email_update = {

     

       499
       499
       -
           keywords : (keyword * bool) list option;

     

       500
       500
       -
           mailbox_ids : (id * bool) list option;

     

       501
       501
       -
         }

     

       502
       502
       -
       

     

       503
       503
       -
         (** Email/set response. See RFC8621 Section 4.8. *)

     

       504
       504
       -
         type email_set_response = {

     

       505
       505
       -
           account_id : id;

     

       506
       506
       -
           old_state : string option;

     

       507
       507
       -
           new_state : string;

     

       508
       508
       -
           created : (id * email) list option;

     

       509
       509
       -
           updated : id list option;

     

       510
       510
       -
           destroyed : id list option;

     

       511
       511
       -
           not_created : (id * set_error) list option;

     

       512
       512
       -
           not_updated : (id * set_error) list option;

     

       513
       513
       -
           not_destroyed : (id * set_error) list option;

     

       514
       514
       -
         }

     

       515
       515
       -
       

     

       516
       516
       -
         (** Email/copy request arguments. See RFC8621 Section 4.9. *)

     

       517
       517
       -
         type email_copy_arguments = {

     

       518
       518
       -
           from_account_id : id;

     

       519
       519
       -
           account_id : id;

     

       520
       520
       -
           create : (id * email_creation) list;

     

       521
       521
       -
           on_success_destroy_original : bool option;

     

       522
       522
       -
         }

     

       523
       523
       -
       

     

       524
       524
       -
         (** Email/copy response. See RFC8621 Section 4.9. *)

     

       525
       525
       -
         type email_copy_response = {

     

       526
       526
       -
           from_account_id : id;

     

       527
       527
       -
           account_id : id;

     

       528
       528
       -
           created : (id * email) list option;

     

       529
       529
       -
           not_created : (id * set_error) list option;

     

       530
       530
       -
         }

     

       531
       531
       -
       

     

       532
       532
       -
         (** Email/import request arguments. See RFC8621 Section 4.10. *)

     

       533
       533
       -
         type email_import_arguments = {

     

       534
       534
       -
           account_id : id;

     

       535
       535
       -
           emails : (id * email_import) list;

     

       536
       536
       -
         }

     

       537
       537
       -
       

     

       538
       538
       -
         and email_import = {

     

       539
       539
       -
           blob_id : id;

     

       540
       540
       -
           mailbox_ids : (id * bool) list;

     

       541
       541
       -
           keywords : (keyword * bool) list option;

     

       542
       542
       -
           received_at : utc_date option;

     

       543
       543
       -
         }

     

       544
       544
       -
       

     

       545
       545
       -
         (** Email/import response. See RFC8621 Section 4.10. *)

     

       546
       546
       -
         type email_import_response = {

     

       547
       547
       -
           account_id : id;

     

       548
       548
       -
           created : (id * email) list option;

     

       549
       549
       -
           not_created : (id * set_error) list option;

     

       550
       550
       -
         }

     

       551
       551
       -
       

     

       552
       552
       -
         (** {1:search_snippet Search snippets} *)

     

       553
       553
       -
       

     

       554
       554
       -
         (** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)

     

       555
       555
       -
         type search_snippet_get_arguments = {

     

       556
       556
       -
           account_id : id;

     

       557
       557
       -
           email_ids : id list;

     

       558
       558
       -
           filter : email_filter_condition;

     

       559
       559
       -
         }

     

       560
       560
       -
       

     

       561
       561
       -
         (** SearchSnippet/get response. See RFC8621 Section 4.11. *)

     

       562
       562
       -
         type search_snippet_get_response = {

     

       563
       563
       -
           account_id : id;

     

       564
       564
       -
           list : (id * search_snippet) list;

     

       565
       565
       -
           not_found : id list;

     

       566
       566
       -
         }

     

       567
       567
       -
       

     

       568
       568
       -
         and search_snippet = {

     

       569
       569
       -
           subject : string option;

     

       570
       570
       -
           preview : string option;

     

       571
       571
       -
         }

     

       572
       572
       -
       

     

       573
       573
       -
         (** {1:submission EmailSubmission objects} *)

     

       574
       574
       -
       

     

       575
       575
       -
         (** EmailSubmission address. See RFC8621 Section 5.1. *)

     

       576
       576
       -
         type submission_address = {

     

       577
       577
       -
           email : string;

     

       578
       578
       -
           parameters : (string * string) list option;

     

       579
       579
       -
         }

     

       580
       580
       -
       

     

       581
       581
       -
         (** Email submission object. See RFC8621 Section 5.1. *)

     

       582
       582
       -
         type email_submission = {

     

       583
       583
       -
           id : id;

     

       584
       584
       -
           identity_id : id;

     

       585
       585
       -
           email_id : id;

     

       586
       586
       -
           thread_id : id;

     

       587
       587
       -
           envelope : envelope option;

     

       588
       588
       -
           send_at : utc_date option;

     

       589
       589
       -
           undo_status : [

     

       590
       590
       -
             | `pending

     

       591
       591
       -
             | `final

     

       592
       592
       -
             | `canceled

     

       593
       593
       -
           ] option;

     

       594
       594
       -
           delivery_status : (string * submission_status) list option;

     

       595
       595
       -
           dsn_blob_ids : (string * id) list option;

     

       596
       596
       -
           mdn_blob_ids : (string * id) list option;

     

       597
       597
       -
         }

     

       598
       598
       -
       

     

       599
       599
       -
         (** Envelope for mail submission. See RFC8621 Section 5.1. *)

     

       600
       600
       -
         and envelope = {

     

       601
       601
       -
           mail_from : submission_address;

     

       602
       602
       -
           rcpt_to : submission_address list;

     

       603
       603
       -
         }

     

       604
       604
       -
       

     

       605
       605
       -
         (** Delivery status for submitted email. See RFC8621 Section 5.1. *)

     

       606
       606
       -
         and submission_status = {

     

       607
       607
       -
           smtp_reply : string;

     

       608
       608
       -
           delivered : string option;

     

       609
       609
       -
         }

     

       610
       610
       -
       

     

       611
       611
       -
         (** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)

     

       612
       612
       -
         type email_submission_get_arguments = {

     

       613
       613
       -
           account_id : id;

     

       614
       614
       -
           ids : id list option;

     

       615
       615
       -
           properties : string list option;

     

       616
       616
       -
         }

     

       617
       617
       -
       

     

       618
       618
       -
         (** EmailSubmission/get response. See RFC8621 Section 5.3. *)

     

       619
       619
       -
         type email_submission_get_response = {

     

       620
       620
       -
           account_id : id;

     

       621
       621
       -
           state : string;

     

       622
       622
       -
           list : email_submission list;

     

       623
       623
       -
           not_found : id list;

     

       624
       624
       -
         }

     

       625
       625
       -
       

     

       626
       626
       -
         (** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)

     

       627
       627
       -
         type email_submission_changes_arguments = {

     

       628
       628
       -
           account_id : id;

     

       629
       629
       -
           since_state : string;

     

       630
       630
       -
           max_changes : unsigned_int option;

     

       631
       631
       -
         }

     

       632
       632
       -
       

     

       633
       633
       -
         (** EmailSubmission/changes response. See RFC8621 Section 5.4. *)

     

       634
       634
       -
         type email_submission_changes_response = {

     

       635
       635
       -
           account_id : id;

     

       636
       636
       -
           old_state : string;

     

       637
       637
       -
           new_state : string;

     

       638
       638
       -
           has_more_changes : bool;

     

       639
       639
       -
           created : id list;

     

       640
       640
       -
           updated : id list;

     

       641
       641
       -
           destroyed : id list;

     

       642
       642
       -
         }

     

       643
       643
       -
       

     

       644
       644
       -
         (** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)

     

       645
       645
       -
         type email_submission_filter_condition = {

     

       646
       646
       -
           identity_id : id option;

     

       647
       647
       -
           email_id : id option;

     

       648
       648
       -
           thread_id : id option;

     

       649
       649
       -
           before : utc_date option;

     

       650
       650
       -
           after : utc_date option;

     

       651
       651
       -
           subject : string option;

     

       652
       652
       -
         }

     

       653
       653
       -
       

     

       654
       654
       -
         type email_submission_query_filter = [

     

       655
       655
       -
           | `And of email_submission_query_filter list

     

       656
       656
       -
           | `Or of email_submission_query_filter list

     

       657
       657
       -
           | `Not of email_submission_query_filter

     

       658
       658
       -
           | `Condition of email_submission_filter_condition

     

       659
       659
       -
         ]

     

       660
       660
       -
       

     

       661
       661
       -
         (** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)

     

       662
       662
       -
         type email_submission_query_arguments = {

     

       663
       663
       -
           account_id : id;

     

       664
       664
       -
           filter : email_submission_query_filter option;

     

       665
       665
       -
           sort : comparator list option;

     

       666
       666
       -
           position : unsigned_int option;

     

       667
       667
       -
           anchor : id option;

     

       668
       668
       -
           anchor_offset : int_t option;

     

       669
       669
       -
           limit : unsigned_int option;

     

       670
       670
       -
           calculate_total : bool option;

     

       671
       671
       -
         }

     

       672
       672
       -
       

     

       673
       673
       -
         (** EmailSubmission/query response. See RFC8621 Section 5.5. *)

     

       674
       674
       -
         type email_submission_query_response = {

     

       675
       675
       -
           account_id : id;

     

       676
       676
       -
           query_state : string;

     

       677
       677
       -
           can_calculate_changes : bool;

     

       678
       678
       -
           position : unsigned_int;

     

       679
       679
       -
           ids : id list;

     

       680
       680
       -
           total : unsigned_int option;

     

       681
       681
       -
         }

     

       682
       682
       -
       

     

       683
       683
       -
         (** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)

     

       684
       684
       -
         type email_submission_set_arguments = {

     

       685
       685
       -
           account_id : id;

     

       686
       686
       -
           if_in_state : string option;

     

       687
       687
       -
           create : (id * email_submission_creation) list option;

     

       688
       688
       -
           update : (id * email_submission_update) list option;

     

       689
       689
       -
           destroy : id list option;

     

       690
       690
       -
           on_success_update_email : (id * email_update) list option;

     

       691
       691
       -
         }

     

       692
       692
       -
       

     

       693
       693
       -
         and email_submission_creation = {

     

       694
       694
       -
           email_id : id;

     

       695
       695
       -
           identity_id : id;

     

       696
       696
       -
           envelope : envelope option;

     

       697
       697
       -
           send_at : utc_date option;

     

       698
       698
       -
         }

     

       699
       699
       -
       

     

       700
       700
       -
         and email_submission_update = {

     

       701
       701
       -
           email_id : id option;

     

       702
       702
       -
           identity_id : id option;

     

       703
       703
       -
           envelope : envelope option;

     

       704
       704
       -
           undo_status : [`canceled] option;

     

       705
       705
       -
         }

     

       706
       706
       -
       

     

       707
       707
       -
         (** EmailSubmission/set response. See RFC8621 Section 5.6. *)

     

       708
       708
       -
         type email_submission_set_response = {

     

       709
       709
       -
           account_id : id;

     

       710
       710
       -
           old_state : string option;

     

       711
       711
       -
           new_state : string;

     

       712
       712
       -
           created : (id * email_submission) list option;

     

       713
       713
       -
           updated : id list option;

     

       714
       714
       -
           destroyed : id list option;

     

       715
       715
       -
           not_created : (id * set_error) list option;

     

       716
       716
       -
           not_updated : (id * set_error) list option;

     

       717
       717
       -
           not_destroyed : (id * set_error) list option;

     

       718
       718
       -
         }

     

       719
       719
       -
       

     

       720
       720
       -
         (** {1:identity Identity objects} *)

     

       721
       721
       -
       

     

       722
       722
       -
         (** Identity for sending mail. See RFC8621 Section 6. *)

     

       723
       723
       -
         type identity = {

     

       724
       724
       -
           id : id;

     

       725
       725
       -
           name : string;

     

       726
       726
       -
           email : string;

     

       727
       727
       -
           reply_to : email_address list option;

     

       728
       728
       -
           bcc : email_address list option;

     

       729
       729
       -
           text_signature : string option;

     

       730
       730
       -
           html_signature : string option;

     

       731
       731
       -
           may_delete : bool;

     

       732
       732
       -
         }

     

       733
       733
       -
       

     

       734
       734
       -
         (** Identity/get request arguments. See RFC8621 Section 6.1. *)

     

       735
       735
       -
         type identity_get_arguments = {

     

       736
       736
       -
           account_id : id;

     

       737
       737
       -
           ids : id list option;

     

       738
       738
       -
           properties : string list option;

     

       739
       739
       -
         }

     

       740
       740
       -
       

     

       741
       741
       -
         (** Identity/get response. See RFC8621 Section 6.1. *)

     

       742
       742
       -
         type identity_get_response = {

     

       743
       743
       -
           account_id : id;

     

       744
       744
       -
           state : string;

     

       745
       745
       -
           list : identity list;

     

       746
       746
       -
           not_found : id list;

     

       747
       747
       -
         }

     

       748
       748
       -
       

     

       749
       749
       -
         (** Identity/changes request arguments. See RFC8621 Section 6.2. *)

     

       750
       750
       -
         type identity_changes_arguments = {

     

       751
       751
       -
           account_id : id;

     

       752
       752
       -
           since_state : string;

     

       753
       753
       -
           max_changes : unsigned_int option;

     

       754
       754
       -
         }

     

       755
       755
       -
       

     

       756
       756
       -
         (** Identity/changes response. See RFC8621 Section 6.2. *)

     

       757
       757
       -
         type identity_changes_response = {

     

       758
       758
       -
           account_id : id;

     

       759
       759
       -
           old_state : string;

     

       760
       760
       -
           new_state : string;

     

       761
       761
       -
           has_more_changes : bool;

     

       762
       762
       -
           created : id list;

     

       763
       763
       -
           updated : id list;

     

       764
       764
       -
           destroyed : id list;

     

       765
       765
       -
         }

     

       766
       766
       -
       

     

       767
       767
       -
         (** Identity/set request arguments. See RFC8621 Section 6.3. *)

     

       768
       768
       -
         type identity_set_arguments = {

     

       769
       769
       -
           account_id : id;

     

       770
       770
       -
           if_in_state : string option;

     

       771
       771
       -
           create : (id * identity_creation) list option;

     

       772
       772
       -
           update : (id * identity_update) list option;

     

       773
       773
       -
           destroy : id list option;

     

       774
       774
       -
         }

     

       775
       775
       -
       

     

       776
       776
       -
         and identity_creation = {

     

       777
       777
       -
           name : string;

     

       778
       778
       -
           email : string;

     

       779
       779
       -
           reply_to : email_address list option;

     

       780
       780
       -
           bcc : email_address list option;

     

       781
       781
       -
           text_signature : string option;

     

       782
       782
       -
           html_signature : string option;

     

       783
       783
       -
         }

     

       784
       784
       -
       

     

       785
       785
       -
         and identity_update = {

     

       786
       786
       -
           name : string option;

     

       787
       787
       -
           email : string option;

     

       788
       788
       -
           reply_to : email_address list option;

     

       789
       789
       -
           bcc : email_address list option;

     

       790
       790
       -
           text_signature : string option;

     

       791
       791
       -
           html_signature : string option;

     

       792
       792
       -
         }

     

       793
       793
       -
       

     

       794
       794
       -
         (** Identity/set response. See RFC8621 Section 6.3. *)

     

       795
       795
       -
         type identity_set_response = {

     

       796
       796
       -
           account_id : id;

     

       797
       797
       -
           old_state : string option;

     

       798
       798
       -
           new_state : string;

     

       799
       799
       -
           created : (id * identity) list option;

     

       800
       800
       -
           updated : id list option;

     

       801
       801
       -
           destroyed : id list option;

     

       802
       802
       -
           not_created : (id * set_error) list option;

     

       803
       803
       -
           not_updated : (id * set_error) list option;

     

       804
       804
       -
           not_destroyed : (id * set_error) list option;

     

       805
       805
       -
         }

     

       806
       806
       -
       

     

       807
       807
       -
         (** {1:vacation_response VacationResponse objects} *)

     

       808
       808
       -
       

     

       809
       809
       -
         (** Vacation auto-reply setting. See RFC8621 Section 7. *)

     

       810
       810
       -
         type vacation_response = {

     

       811
       811
       -
           id : id;

     

       812
       812
       -
           is_enabled : bool;

     

       813
       813
       -
           from_date : utc_date option;

     

       814
       814
       -
           to_date : utc_date option;

     

       815
       815
       -
           subject : string option;

     

       816
       816
       -
           text_body : string option;

     

       817
       817
       -
           html_body : string option;

     

       818
       818
       -
         }

     

       819
       819
       -
       

     

       820
       820
       -
         (** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)

     

       821
       821
       -
         type vacation_response_get_arguments = {

     

       822
       822
       -
           account_id : id;

     

       823
       823
       -
           ids : id list option;

     

       824
       824
       -
           properties : string list option;

     

       825
       825
       -
         }

     

       826
       826
       -
       

     

       827
       827
       -
         (** VacationResponse/get response. See RFC8621 Section 7.2. *)

     

       828
       828
       -
         type vacation_response_get_response = {

     

       829
       829
       -
           account_id : id;

     

       830
       830
       -
           state : string;

     

       831
       831
       -
           list : vacation_response list;

     

       832
       832
       -
           not_found : id list;

     

       833
       833
       -
         }

     

       834
       834
       -
       

     

       835
       835
       -
         (** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)

     

       836
       836
       -
         type vacation_response_set_arguments = {

     

       837
       837
       -
           account_id : id;

     

       838
       838
       -
           if_in_state : string option;

     

       839
       839
       -
           update : (id * vacation_response_update) list;

     

       840
       840
       -
         }

     

       841
       841
       -
       

     

       842
       842
       -
         and vacation_response_update = {

     

       843
       843
       -
           is_enabled : bool option;

     

       844
       844
       -
           from_date : utc_date option;

     

       845
       845
       -
           to_date : utc_date option;

     

       846
       846
       -
           subject : string option;

     

       847
       847
       -
           text_body : string option;

     

       848
       848
       -
           html_body : string option;

     

       849
       849
       -
         }

     

       850
       850
       -
       

     

       851
       851
       -
         (** VacationResponse/set response. See RFC8621 Section 7.3. *)

     

       852
       852
       -
         type vacation_response_set_response = {

     

       853
       853
       -
           account_id : id;

     

       854
       854
       -
           old_state : string option;

     

       855
       855
       -
           new_state : string;

     

       856
       856
       -
           updated : id list option;

     

       857
       857
       -
           not_updated : (id * set_error) list option;

     

       858
       858
       -
         }

     

       859
       859
       -
         

     

       860
       860
       -
         (** {1:message_flags Message Flags and Mailbox Attributes} *)

     

       861
       861
       -
         

     

       862
       862
       -
         (** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)

     

       863
       863
       -
         type flag_color =

     

       864
       864
       -
           | Red     (** Bit pattern 000 *)

     

       865
       865
       -
           | Orange  (** Bit pattern 100 *)

     

       866
       866
       -
           | Yellow  (** Bit pattern 010 *)

     

       867
       867
       -
           | Green   (** Bit pattern 111 *)

     

       868
       868
       -
           | Blue    (** Bit pattern 001 *)

     

       869
       869
       -
           | Purple  (** Bit pattern 101 *)

     

       870
       870
       -
           | Gray    (** Bit pattern 011 *)

     

       871
       871
       -
         

     

       872
       872
       -
         (** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)

     

       873
       873
       -
         type message_keyword =

     

       874
       874
       -
           | Notify         (** Indicate a notification should be shown for this message *)

     

       875
       875
       -
           | Muted          (** User is not interested in future replies to this thread *)

     

       876
       876
       -
           | Followed       (** User is particularly interested in future replies to this thread *)

     

       877
       877
       -
           | Memo           (** Message is a note-to-self about another message in the same thread *)

     

       878
       878
       -
           | HasMemo        (** Message has an associated memo with the $memo keyword *)

     

       879
       879
       -
           | HasAttachment  (** Message has an attachment *)

     

       880
       880
       -
           | HasNoAttachment (** Message does not have an attachment *)

     

       881
       881
       -
           | AutoSent       (** Message was sent automatically as a response due to a user rule *)

     

       882
       882
       -
           | Unsubscribed   (** User has unsubscribed from the thread this message is in *)

     

       883
       883
       -
           | CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)

     

       884
       884
       -
           | Imported       (** Message was imported from another mailbox *)

     

       885
       885
       -
           | IsTrusted      (** Server has verified authenticity of the from name and email *)

     

       886
       886
       -
           | MaskedEmail    (** Message was received via an alias created for an individual sender *)

     

       887
       887
       -
           | New            (** Message should be made more prominent due to a recent action *)

     

       888
       888
       -
           | MailFlagBit0   (** Bit 0 of the 3-bit flag color pattern *)

     

       889
       889
       -
           | MailFlagBit1   (** Bit 1 of the 3-bit flag color pattern *)

     

       890
       890
       -
           | MailFlagBit2   (** Bit 2 of the 3-bit flag color pattern *)

     

       891
       891
       -
           | OtherKeyword of string (** Other non-standard keywords *)

     

       892
       892
       -
         

     

       893
       893
       -
         (** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)

     

       894
       894
       -
         type mailbox_attribute =

     

       895
       895
       -
           | Snoozed    (** Mailbox containing messages that have been snoozed *)

     

       896
       896
       -
           | Scheduled  (** Mailbox containing messages scheduled to be sent later *)

     

       897
       897
       -
           | Memos      (** Mailbox containing messages with the $memo keyword *)

     

       898
       898
       -
           | OtherAttribute of string (** Other non-standard mailbox attributes *)

     

       899
       899
       -
         

     

       900
       900
       -
         (** Functions for working with flag colors based on the specification in 

     

       901
       901
       -
             draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)

     

       902
       902
       -
           

     

       903
       903
       -
         (** Convert bit pattern to flag color *)

     

       904
       904
       -
         let flag_color_of_bits bit0 bit1 bit2 =

     

       905
       905
       -
           match (bit0, bit1, bit2) with

     

       906
       906
       -
           | (false, false, false) -> Red     (* 000 *)

     

       907
       907
       -
           | (true, false, false) -> Orange   (* 100 *)

     

       908
       908
       -
           | (false, true, false) -> Yellow   (* 010 *)

     

       909
       909
       -
           | (true, true, true) -> Green      (* 111 *)

     

       910
       910
       -
           | (false, false, true) -> Blue     (* 001 *)

     

       911
       911
       -
           | (true, false, true) -> Purple    (* 101 *)

     

       912
       912
       -
           | (false, true, true) -> Gray      (* 011 *)

     

       913
       913
       -
           | (true, true, false) -> Green     (* 110 - not in spec, defaulting to green *)

     

       914
       914
       -
       

     

       915
       915
       -
         (** Get bits for a flag color *)

     

       916
       916
       -
         let bits_of_flag_color = function

     

       917
       917
       -
           | Red -> (false, false, false)

     

       918
       918
       -
           | Orange -> (true, false, false)

     

       919
       919
       -
           | Yellow -> (false, true, false)

     

       920
       920
       -
           | Green -> (true, true, true)

     

       921
       921
       -
           | Blue -> (false, false, true)

     

       922
       922
       -
           | Purple -> (true, false, true)

     

       923
       923
       -
           | Gray -> (false, true, true)

     

       924
       924
       -
       

     

       925
       925
       -
         (** Check if a keyword list contains a flag color *)

     

       926
       926
       -
         let has_flag_color keywords =

     

       927
       927
       -
           let has_bit0 = List.exists (function 

     

       928
       928
       -
             | (Custom s, true) when s = "$MailFlagBit0" -> true 

     

       929
       929
       -
             | _ -> false

     

       930
       930
       -
           ) keywords in

     

       931
       931
       -
           

     

       932
       932
       -
           let has_bit1 = List.exists (function

     

       933
       933
       -
             | (Custom s, true) when s = "$MailFlagBit1" -> true 

     

       934
       934
       -
             | _ -> false

     

       935
       935
       -
           ) keywords in

     

       936
       936
       -
           

     

       937
       937
       -
           let has_bit2 = List.exists (function

     

       938
       938
       -
             | (Custom s, true) when s = "$MailFlagBit2" -> true 

     

       939
       939
       -
             | _ -> false

     

       940
       940
       -
           ) keywords in

     

       941
       941
       -
           

     

       942
       942
       -
           has_bit0 || has_bit1 || has_bit2

     

       943
       943
       -
       

     

       944
       944
       -
         (** Extract flag color from keywords if present *)

     

       945
       945
       -
         let get_flag_color keywords =

     

       946
       946
       -
           (* First check if the message has the \Flagged system flag *)

     

       947
       947
       -
           let is_flagged = List.exists (function

     

       948
       948
       -
             | (Flagged, true) -> true 

     

       949
       949
       -
             | _ -> false

     

       950
       950
       -
           ) keywords in

     

       951
       951
       -
           

     

       952
       952
       -
           if not is_flagged then

     

       953
       953
       -
             None

     

       954
       954
       -
           else

     

       955
       955
       -
             (* Get values of each bit flag *)

     

       956
       956
       -
             let bit0 = List.exists (function

     

       957
       957
       -
               | (Custom s, true) when s = "$MailFlagBit0" -> true 

     

       958
       958
       -
               | _ -> false

     

       959
       959
       -
             ) keywords in

     

       960
       960
       -
             

     

       961
       961
       -
             let bit1 = List.exists (function

     

       962
       962
       -
               | (Custom s, true) when s = "$MailFlagBit1" -> true 

     

       963
       963
       -
               | _ -> false

     

       964
       964
       -
             ) keywords in

     

       965
       965
       -
             

     

       966
       966
       -
             let bit2 = List.exists (function

     

       967
       967
       -
               | (Custom s, true) when s = "$MailFlagBit2" -> true 

     

       968
       968
       -
               | _ -> false

     

       969
       969
       -
             ) keywords in

     

       970
       970
       -
             

     

       971
       971
       -
             Some (flag_color_of_bits bit0 bit1 bit2)

     

       972
       972
       -
       

     

       973
       973
       -
         (** Convert a message keyword to its string representation *)

     

       974
       974
       -
         let string_of_message_keyword = function

     

       975
       975
       -
           | Notify -> "$notify"

     

       976
       976
       -
           | Muted -> "$muted"

     

       977
       977
       -
           | Followed -> "$followed"

     

       978
       978
       -
           | Memo -> "$memo"

     

       979
       979
       -
           | HasMemo -> "$hasmemo"

     

       980
       980
       -
           | HasAttachment -> "$hasattachment"

     

       981
       981
       -
           | HasNoAttachment -> "$hasnoattachment"

     

       982
       982
       -
           | AutoSent -> "$autosent"

     

       983
       983
       -
           | Unsubscribed -> "$unsubscribed"

     

       984
       984
       -
           | CanUnsubscribe -> "$canunsubscribe"

     

       985
       985
       -
           | Imported -> "$imported"

     

       986
       986
       -
           | IsTrusted -> "$istrusted"

     

       987
       987
       -
           | MaskedEmail -> "$maskedemail"

     

       988
       988
       -
           | New -> "$new"

     

       989
       989
       -
           | MailFlagBit0 -> "$MailFlagBit0"

     

       990
       990
       -
           | MailFlagBit1 -> "$MailFlagBit1"

     

       991
       991
       -
           | MailFlagBit2 -> "$MailFlagBit2"

     

       992
       992
       -
           | OtherKeyword s -> s

     

       993
       993
       -
       

     

       994
       994
       -
         (** Parse a string into a message keyword *)

     

       995
       995
       -
         let message_keyword_of_string = function

     

       996
       996
       -
           | "$notify" -> Notify

     

       997
       997
       -
           | "$muted" -> Muted

     

       998
       998
       -
           | "$followed" -> Followed

     

       999
       999
       -
           | "$memo" -> Memo

     

       1000
       1000
       -
           | "$hasmemo" -> HasMemo

     

       1001
       1001
       -
           | "$hasattachment" -> HasAttachment

     

       1002
       1002
       -
           | "$hasnoattachment" -> HasNoAttachment

     

       1003
       1003
       -
           | "$autosent" -> AutoSent

     

       1004
       1004
       -
           | "$unsubscribed" -> Unsubscribed

     

       1005
       1005
       -
           | "$canunsubscribe" -> CanUnsubscribe

     

       1006
       1006
       -
           | "$imported" -> Imported

     

       1007
       1007
       -
           | "$istrusted" -> IsTrusted

     

       1008
       1008
       -
           | "$maskedemail" -> MaskedEmail

     

       1009
       1009
       -
           | "$new" -> New

     

       1010
       1010
       -
           | "$MailFlagBit0" -> MailFlagBit0

     

       1011
       1011
       -
           | "$MailFlagBit1" -> MailFlagBit1

     

       1012
       1012
       -
           | "$MailFlagBit2" -> MailFlagBit2

     

       1013
       1013
       -
           | s -> OtherKeyword s

     

       1014
       1014
       -
       

     

       1015
       1015
       -
         (** Convert a mailbox attribute to its string representation *)

     

       1016
       1016
       -
         let string_of_mailbox_attribute = function

     

       1017
       1017
       -
           | Snoozed -> "Snoozed"

     

       1018
       1018
       -
           | Scheduled -> "Scheduled"

     

       1019
       1019
       -
           | Memos -> "Memos"

     

       1020
       1020
       -
           | OtherAttribute s -> s

     

       1021
       1021
       -
       

     

       1022
       1022
       -
         (** Parse a string into a mailbox attribute *)

     

       1023
       1023
       -
         let mailbox_attribute_of_string = function

     

       1024
       1024
       -
           | "Snoozed" -> Snoozed

     

       1025
       1025
       -
           | "Scheduled" -> Scheduled

     

       1026
       1026
       -
           | "Memos" -> Memos

     

       1027
       1027
       -
           | s -> OtherAttribute s

     

       1028
       1028
       -
           

     

       1029
       1029
       -
         (** Get a human-readable representation of a flag color *)

     

       1030
       1030
       -
         let human_readable_flag_color = function

     

       1031
       1031
       -
           | Red -> "Red"

     

       1032
       1032
       -
           | Orange -> "Orange"

     

       1033
       1033
       -
           | Yellow -> "Yellow"

     

       1034
       1034
       -
           | Green -> "Green"

     

       1035
       1035
       -
           | Blue -> "Blue"

     

       1036
       1036
       -
           | Purple -> "Purple"

     

       1037
       1037
       -
           | Gray -> "Gray"

     

       1038
       1038
       -
         

     

       1039
       1039
       -
         (** Get a human-readable representation of a message keyword *)

     

       1040
       1040
       -
         let human_readable_message_keyword = function

     

       1041
       1041
       -
           | Notify -> "Notify"

     

       1042
       1042
       -
           | Muted -> "Muted"

     

       1043
       1043
       -
           | Followed -> "Followed"

     

       1044
       1044
       -
           | Memo -> "Memo"

     

       1045
       1045
       -
           | HasMemo -> "Has Memo"

     

       1046
       1046
       -
           | HasAttachment -> "Has Attachment"

     

       1047
       1047
       -
           | HasNoAttachment -> "No Attachment"

     

       1048
       1048
       -
           | AutoSent -> "Auto Sent"

     

       1049
       1049
       -
           | Unsubscribed -> "Unsubscribed"

     

       1050
       1050
       -
           | CanUnsubscribe -> "Can Unsubscribe"

     

       1051
       1051
       -
           | Imported -> "Imported"

     

       1052
       1052
       -
           | IsTrusted -> "Trusted"

     

       1053
       1053
       -
           | MaskedEmail -> "Masked Email"

     

       1054
       1054
       -
           | New -> "New"

     

       1055
       1055
       -
           | MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> "Flag Bit"

     

       1056
       1056
       -
           | OtherKeyword s -> s

     

       1057
       1057
       -
         

     

       1058
       1058
       -
         (** Format email keywords into a human-readable string representation *)

     

       1059
       1059
       -
         let format_email_keywords keywords =

     

       1060
       1060
       -
           (* Get flag color if present *)

     

       1061
       1061
       -
           let color_str =

     

       1062
       1062
       -
             match get_flag_color keywords with

     

       1063
       1063
       -
             | Some color -> human_readable_flag_color color

     

       1064
       1064
       -
             | None -> ""

     

       1065
       1065
       -
           in

     

       1066
       1066
       -
           

     

       1067
       1067
       -
           (* Get standard JMAP keywords *)

     

       1068
       1068
       -
           let standard_keywords = List.filter_map (fun (kw, active) ->

     

       1069
       1069
       -
             if not active then None

     

       1070
       1070
       -
             else match kw with

     

       1071
       1071
       -
             | Flagged -> Some "Flagged"

     

       1072
       1072
       -
             | Answered -> Some "Answered"

     

       1073
       1073
       -
             | Draft -> Some "Draft"

     

       1074
       1074
       -
             | Forwarded -> Some "Forwarded"

     

       1075
       1075
       -
             | Phishing -> Some "Phishing"

     

       1076
       1076
       -
             | Junk -> Some "Junk"

     

       1077
       1077
       -
             | NotJunk -> Some "Not Junk"

     

       1078
       1078
       -
             | Seen -> Some "Seen"

     

       1079
       1079
       -
             | Unread -> Some "Unread"

     

       1080
       1080
       -
             | _ -> None

     

       1081
       1081
       -
           ) keywords in

     

       1082
       1082
       -
           

     

       1083
       1083
       -
           (* Get message keywords *)

     

       1084
       1084
       -
           let message_keywords = List.filter_map (fun (kw, active) ->

     

       1085
       1085
       -
             if not active then None

     

       1086
       1086
       -
             else match kw with

     

       1087
       1087
       -
             | Custom s ->

     

       1088
       1088
       -
               (* Try to parse as message keyword *)

     

       1089
       1089
       -
               let message_kw = message_keyword_of_string s in

     

       1090
       1090
       -
               (match message_kw with

     

       1091
       1091
       -
               | OtherKeyword _ -> None

     

       1092
       1092
       -
               | MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> None

     

       1093
       1093
       -
               | kw -> Some (human_readable_message_keyword kw))

     

       1094
       1094
       -
             | _ -> None

     

       1095
       1095
       -
           ) keywords in

     

       1096
       1096
       -
           

     

       1097
       1097
       -
           (* Combine all human-readable labels *)

     

       1098
       1098
       -
           let all_parts = 

     

       1099
       1099
       -
             (if color_str <> "" then [color_str] else []) @

     

       1100
       1100
       -
             standard_keywords @ 

     

       1101
       1101
       -
             message_keywords 

     

       1102
       1102
       -
           in

     

       1103
       1103
       -
           

     

       1104
       1104
       -
           String.concat ", " all_parts

     

       1105
       1105
       -
       end

     

       1106
       1106
       -
       

     

       1107
       1107
       -
       (** {1 JSON serialization} *)

     

       1108
       1108
       -
       

     

       1109
       1109
       -
       module Json = struct

     

       1110
       1110
       -
         open Types

     

       1111
       1111
       -
         

     

       1112
       1112
       -
         (** {2 Helper functions for serialization} *)

     

       1113
       1113
       -
       

     

       1114
       1114
       -
         let string_of_mailbox_role = function

     

       1115
       1115
       -
           | All -> "all"

     

       1116
       1116
       -
           | Archive -> "archive"

     

       1117
       1117
       -
           | Drafts -> "drafts"

     

       1118
       1118
       -
           | Flagged -> "flagged"

     

       1119
       1119
       -
           | Important -> "important"

     

       1120
       1120
       -
           | Inbox -> "inbox"

     

       1121
       1121
       -
           | Junk -> "junk"

     

       1122
       1122
       -
           | Sent -> "sent"

     

       1123
       1123
       -
           | Trash -> "trash"

     

       1124
       1124
       -
           | Unknown s -> s

     

       1125
       1125
       -
         

     

       1126
       1126
       -
         let mailbox_role_of_string = function

     

       1127
       1127
       -
           | "all" -> All

     

       1128
       1128
       -
           | "archive" -> Archive

     

       1129
       1129
       -
           | "drafts" -> Drafts

     

       1130
       1130
       -
           | "flagged" -> Flagged

     

       1131
       1131
       -
           | "important" -> Important

     

       1132
       1132
       -
           | "inbox" -> Inbox

     

       1133
       1133
       -
           | "junk" -> Junk

     

       1134
       1134
       -
           | "sent" -> Sent

     

       1135
       1135
       -
           | "trash" -> Trash

     

       1136
       1136
       -
           | s -> Unknown s

     

       1137
       1137
       -
       

     

       1138
       1138
       -
         let string_of_keyword = function

     

       1139
       1139
       -
           | Flagged -> "$flagged"

     

       1140
       1140
       -
           | Answered -> "$answered"

     

       1141
       1141
       -
           | Draft -> "$draft"

     

       1142
       1142
       -
           | Forwarded -> "$forwarded"

     

       1143
       1143
       -
           | Phishing -> "$phishing"

     

       1144
       1144
       -
           | Junk -> "$junk"

     

       1145
       1145
       -
           | NotJunk -> "$notjunk"

     

       1146
       1146
       -
           | Seen -> "$seen"

     

       1147
       1147
       -
           | Unread -> "$unread"

     

       1148
       1148
       -
           | Custom s -> s

     

       1149
       1149
       -
         

     

       1150
       1150
       -
         let keyword_of_string = function

     

       1151
       1151
       -
           | "$flagged" -> Flagged

     

       1152
       1152
       -
           | "$answered" -> Answered

     

       1153
       1153
       -
           | "$draft" -> Draft

     

       1154
       1154
       -
           | "$forwarded" -> Forwarded

     

       1155
       1155
       -
           | "$phishing" -> Phishing

     

       1156
       1156
       -
           | "$junk" -> Junk

     

       1157
       1157
       -
           | "$notjunk" -> NotJunk

     

       1158
       1158
       -
           | "$seen" -> Seen

     

       1159
       1159
       -
           | "$unread" -> Unread

     

       1160
       1160
       -
           | s -> Custom s

     

       1161
       1161
       -
       

     

       1162
       1162
       -
         (** {2 Mailbox serialization} *)

     

       1163
       1163
       -
       

     

       1164
       1164
       -
         (** TODO:claude - Need to implement all JSON serialization functions 

     

       1165
       1165
       -
             for each type we've defined. This would be a substantial amount of

     

       1166
       1166
       -
             code and likely require additional understanding of the ezjsonm API. 

     

       1167
       1167
       -
             

     

       1168
       1168
       -
             For a full implementation, we would need functions to convert between

     

       1169
       1169
       -
             OCaml types and JSON for each of:

     

       1170
       1170
       -
             - mailbox, mailbox_rights, mailbox query/update operations

     

       1171
       1171
       -
             - thread operations

     

       1172
       1172
       -
             - email, email_address, header, email_body_part

     

       1173
       1173
       -
             - email query/update operations

     

       1174
       1174
       -
             - submission operations 

     

       1175
       1175
       -
             - identity operations

     

       1176
       1176
       -
             - vacation response operations

     

       1177
       1177
       -
         *)

     

       1178
       1178
       -
       end

     

       1179
       1179
       -
       

     

       1180
       1180
       -
       (** {1 API functions} *)

     

       1181
       1181
       -
       

     

       1182
       1182
       -
       open Lwt.Syntax

     

       1183
       1183
       -
       open Jmap.Api

     

       1184
       1184
       -
       open Jmap.Types

     

       1185
       1185
       -
       

     

       1186
       1186
       -
       (** Authentication credentials for a JMAP server *)

     

       1187
       1187
       -
       type credentials = {

     

       1188
       1188
       -
         username: string;

     

       1189
       1189
       -
         password: string;

     

       1190
       1190
       -
       }

     

       1191
       1191
       -
       

     

       1192
       1192
       -
       (** Connection to a JMAP mail server *)

     

       1193
       1193
       -
       type connection = {

     

       1194
       1194
       -
         session: Jmap.Types.session;

     

       1195
       1195
       -
         config: Jmap.Api.config;

     

       1196
       1196
       -
       }

     

       1197
       1197
       -
       

     

       1198
       1198
       -
       (** Convert JSON mail object to OCaml type *)

     

       1199
       1199
       -
       let mailbox_of_json json =

     

       1200
       1200
       -
         try

     

       1201
       1201
       -
           let open Ezjsonm in

     

       1202
       1202
       -
           let id = get_string (find json ["id"]) in

     

       1203
       1203
       -
           let name = get_string (find json ["name"]) in

     

       1204
       1204
       -
           (* Handle parentId which can be null *)

     

       1205
       1205
       -
           let parent_id = 

     

       1206
       1206
       -
             match find_opt json ["parentId"] with

     

       1207
       1207
       -
             | Some (`Null) -> None 

     

       1208
       1208
       -
             | Some (`String s) -> Some s

     

       1209
       1209
       -
             | None -> None

     

       1210
       1210
       -
             | _ -> None

     

       1211
       1211
       -
           in

     

       1212
       1212
       -
           (* Handle role which might be null *)

     

       1213
       1213
       -
           let role = 

     

       1214
       1214
       -
             match find_opt json ["role"] with

     

       1215
       1215
       -
             | Some (`Null) -> None

     

       1216
       1216
       -
             | Some (`String s) -> Some (Json.mailbox_role_of_string s)

     

       1217
       1217
       -
             | None -> None

     

       1218
       1218
       -
             | _ -> None

     

       1219
       1219
       -
           in

     

       1220
       1220
       -
           let sort_order = get_int (find json ["sortOrder"]) in

     

       1221
       1221
       -
           let total_emails = get_int (find json ["totalEmails"]) in

     

       1222
       1222
       -
           let unread_emails = get_int (find json ["unreadEmails"]) in

     

       1223
       1223
       -
           let total_threads = get_int (find json ["totalThreads"]) in

     

       1224
       1224
       -
           let unread_threads = get_int (find json ["unreadThreads"]) in

     

       1225
       1225
       -
           let is_subscribed = get_bool (find json ["isSubscribed"]) in

     

       1226
       1226
       -
           let rights_json = find json ["myRights"] in

     

       1227
       1227
       -
           let my_rights = {

     

       1228
       1228
       -
             Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);

     

       1229
       1229
       -
             may_add_items = get_bool (find rights_json ["mayAddItems"]);

     

       1230
       1230
       -
             may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);

     

       1231
       1231
       -
             may_set_seen = get_bool (find rights_json ["maySetSeen"]);

     

       1232
       1232
       -
             may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);

     

       1233
       1233
       -
             may_create_child = get_bool (find rights_json ["mayCreateChild"]);

     

       1234
       1234
       -
             may_rename = get_bool (find rights_json ["mayRename"]);

     

       1235
       1235
       -
             may_delete = get_bool (find rights_json ["mayDelete"]);

     

       1236
       1236
       -
             may_submit = get_bool (find rights_json ["maySubmit"]);

     

       1237
       1237
       -
           } in

     

       1238
       1238
       -
           let result = {

     

       1239
       1239
       -
             Types.id;

     

       1240
       1240
       -
             name;

     

       1241
       1241
       -
             parent_id;

     

       1242
       1242
       -
             role;

     

       1243
       1243
       -
             sort_order;

     

       1244
       1244
       -
             total_emails;

     

       1245
       1245
       -
             unread_emails;

     

       1246
       1246
       -
             total_threads;

     

       1247
       1247
       -
             unread_threads;

     

       1248
       1248
       -
             is_subscribed;

     

       1249
       1249
       -
             my_rights;

     

       1250
       1250
       -
           } in

     

       1251
       1251
       -
           Ok (result)

     

       1252
       1252
       -
         with

     

       1253
       1253
       -
         | Not_found -> 

     

       1254
       1254
       -
             Error (Parse_error "Required field not found in mailbox object")

     

       1255
       1255
       -
         | Invalid_argument msg -> 

     

       1256
       1256
       -
             Error (Parse_error msg)

     

       1257
       1257
       -
         | e -> 

     

       1258
       1258
       -
             Error (Parse_error (Printexc.to_string e))

     

       1259
       1259
       -
       

     

       1260
       1260
       -
       (** Convert JSON email object to OCaml type *)

     

       1261
       1261
       -
       let email_of_json json =

     

       1262
       1262
       -
         try

     

       1263
       1263
       -
           let open Ezjsonm in

     

       1264
       1264
       -
           

     

       1265
       1265
       -
           let id = get_string (find json ["id"]) in

     

       1266
       1266
       -
           let blob_id = get_string (find json ["blobId"]) in

     

       1267
       1267
       -
           let thread_id = get_string (find json ["threadId"]) in

     

       1268
       1268
       -
           

     

       1269
       1269
       -
           (* Process mailboxIds map *)

     

       1270
       1270
       -
           let mailbox_ids_json = find json ["mailboxIds"] in

     

       1271
       1271
       -
           let mailbox_ids = match mailbox_ids_json with

     

       1272
       1272
       -
             | `O items -> List.map (fun (id, v) -> (id, get_bool v)) items

     

       1273
       1273
       -
             | _ -> raise (Invalid_argument "mailboxIds is not an object")

     

       1274
       1274
       -
           in

     

       1275
       1275
       -
           

     

       1276
       1276
       -
           (* Process keywords map *)

     

       1277
       1277
       -
           let keywords_json = find json ["keywords"] in

     

       1278
       1278
       -
           let keywords = match keywords_json with

     

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

     

       1280
       1280
       -
                 (Json.keyword_of_string k, get_bool v)) items

     

       1281
       1281
       -
             | _ -> raise (Invalid_argument "keywords is not an object")

     

       1282
       1282
       -
           in

     

       1283
       1283
       -
           

     

       1284
       1284
       -
           let size = get_int (find json ["size"]) in

     

       1285
       1285
       -
           let received_at = get_string (find json ["receivedAt"]) in

     

       1286
       1286
       -
           

     

       1287
       1287
       -
           (* Handle messageId which might be an array or missing *)

     

       1288
       1288
       -
           let message_id = 

     

       1289
       1289
       -
             match find_opt json ["messageId"] with

     

       1290
       1290
       -
             | Some (`A ids) -> List.map (fun id -> 

     

       1291
       1291
       -
                 match id with 

     

       1292
       1292
       -
                 | `String s -> s

     

       1293
       1293
       -
                 | _ -> raise (Invalid_argument "messageId item is not a string")

     

       1294
       1294
       -
               ) ids

     

       1295
       1295
       -
             | Some (`String s) -> [s] (* Handle single string case *)

     

       1296
       1296
       -
             | None -> [] (* Handle missing case *)

     

       1297
       1297
       -
             | _ -> raise (Invalid_argument "messageId has unexpected type")

     

       1298
       1298
       -
           in

     

       1299
       1299
       -
           

     

       1300
       1300
       -
           (* Parse optional fields *)

     

       1301
       1301
       -
           let parse_email_addresses opt_json =

     

       1302
       1302
       -
             match opt_json with

     

       1303
       1303
       -
             | Some (`A items) -> 

     

       1304
       1304
       -
                 Some (List.map (fun addr_json ->

     

       1305
       1305
       -
                   let name = 

     

       1306
       1306
       -
                     match find_opt addr_json ["name"] with

     

       1307
       1307
       -
                     | Some (`String s) -> Some s

     

       1308
       1308
       -
                     | Some (`Null) -> None

     

       1309
       1309
       -
                     | None -> None

     

       1310
       1310
       -
                     | _ -> None

     

       1311
       1311
       -
                   in

     

       1312
       1312
       -
                   let email = get_string (find addr_json ["email"]) in

     

       1313
       1313
       -
                   let parameters = 

     

       1314
       1314
       -
                     match find_opt addr_json ["parameters"] with

     

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

     

       1316
       1316
       -
                         match v with

     

       1317
       1317
       -
                         | `String s -> (k, s)

     

       1318
       1318
       -
                         | _ -> (k, "")

     

       1319
       1319
       -
                       ) items

     

       1320
       1320
       -
                     | _ -> []

     

       1321
       1321
       -
                   in

     

       1322
       1322
       -
                   { Types.name; email; parameters }

     

       1323
       1323
       -
                 ) items)

     

       1324
       1324
       -
             | _ -> None

     

       1325
       1325
       -
           in

     

       1326
       1326
       -
           

     

       1327
       1327
       -
           (* Handle optional string arrays with null handling *)

     

       1328
       1328
       -
           let parse_string_array_opt field_name =

     

       1329
       1329
       -
             match find_opt json [field_name] with

     

       1330
       1330
       -
             | Some (`A ids) -> 

     

       1331
       1331
       -
                 Some (List.filter_map (function 

     

       1332
       1332
       -
                   | `String s -> Some s 

     

       1333
       1333
       -
                   | _ -> None

     

       1334
       1334
       -
                 ) ids)

     

       1335
       1335
       -
             | Some (`Null) -> None

     

       1336
       1336
       -
             | None -> None

     

       1337
       1337
       -
             | _ -> None

     

       1338
       1338
       -
           in

     

       1339
       1339
       -
           

     

       1340
       1340
       -
           let in_reply_to = parse_string_array_opt "inReplyTo" in

     

       1341
       1341
       -
           let references = parse_string_array_opt "references" in

     

       1342
       1342
       -
           

     

       1343
       1343
       -
           let sender = parse_email_addresses (find_opt json ["sender"]) in

     

       1344
       1344
       -
           let from = parse_email_addresses (find_opt json ["from"]) in

     

       1345
       1345
       -
           let to_ = parse_email_addresses (find_opt json ["to"]) in

     

       1346
       1346
       -
           let cc = parse_email_addresses (find_opt json ["cc"]) in

     

       1347
       1347
       -
           let bcc = parse_email_addresses (find_opt json ["bcc"]) in

     

       1348
       1348
       -
           let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in

     

       1349
       1349
       -
           

     

       1350
       1350
       -
           (* Handle optional string fields with null handling *)

     

       1351
       1351
       -
           let parse_string_opt field_name =

     

       1352
       1352
       -
             match find_opt json [field_name] with

     

       1353
       1353
       -
             | Some (`String s) -> Some s

     

       1354
       1354
       -
             | Some (`Null) -> None

     

       1355
       1355
       -
             | None -> None

     

       1356
       1356
       -
             | _ -> None

     

       1357
       1357
       -
           in

     

       1358
       1358
       -
           

     

       1359
       1359
       -
           let subject = parse_string_opt "subject" in

     

       1360
       1360
       -
           let sent_at = parse_string_opt "sentAt" in

     

       1361
       1361
       -
           

     

       1362
       1362
       -
           (* Handle optional boolean fields with null handling *)

     

       1363
       1363
       -
           let parse_bool_opt field_name =

     

       1364
       1364
       -
             match find_opt json [field_name] with

     

       1365
       1365
       -
             | Some (`Bool b) -> Some b

     

       1366
       1366
       -
             | Some (`Null) -> None

     

       1367
       1367
       -
             | None -> None

     

       1368
       1368
       -
             | _ -> None

     

       1369
       1369
       -
           in

     

       1370
       1370
       -
           

     

       1371
       1371
       -
           let has_attachment = parse_bool_opt "hasAttachment" in

     

       1372
       1372
       -
           let preview = parse_string_opt "preview" in

     

       1373
       1373
       -
           

     

       1374
       1374
       -
           (* TODO Body parts parsing would go here - omitting for brevity *)

     

       1375
       1375
       -
           Ok ({

     

       1376
       1376
       -
             Types.id;

     

       1377
       1377
       -
             blob_id;

     

       1378
       1378
       -
             thread_id;

     

       1379
       1379
       -
             mailbox_ids;

     

       1380
       1380
       -
             keywords;

     

       1381
       1381
       -
             size;

     

       1382
       1382
       -
             received_at;

     

       1383
       1383
       -
             message_id;

     

       1384
       1384
       -
             in_reply_to;

     

       1385
       1385
       -
             references;

     

       1386
       1386
       -
             sender;

     

       1387
       1387
       -
             from;

     

       1388
       1388
       -
             to_;

     

       1389
       1389
       -
             cc;

     

       1390
       1390
       -
             bcc;

     

       1391
       1391
       -
             reply_to;

     

       1392
       1392
       -
             subject;

     

       1393
       1393
       -
             sent_at;

     

       1394
       1394
       -
             has_attachment;

     

       1395
       1395
       -
             preview;

     

       1396
       1396
       -
             body_values = None;

     

       1397
       1397
       -
             text_body = None;

     

       1398
       1398
       -
             html_body = None;

     

       1399
       1399
       -
             attachments = None;

     

       1400
       1400
       -
             headers = None;

     

       1401
       1401
       -
           })

     

       1402
       1402
       -
         with

     

       1403
       1403
       -
         | Not_found -> 

     

       1404
       1404
       -
             Error (Parse_error "Required field not found in email object")

     

       1405
       1405
       -
         | Invalid_argument msg -> 

     

       1406
       1406
       -
             Error (Parse_error msg)

     

       1407
       1407
       -
         | e -> 

     

       1408
       1408
       -
             Error (Parse_error (Printexc.to_string e))

     

       1409
       1409
       -
       

     

       1410
       1410
       -
       (** Login to a JMAP server and establish a connection

     

       1411
       1411
       -
           @param uri The URI of the JMAP server

     

       1412
       1412
       -
           @param credentials Authentication credentials

     

       1413
       1413
       -
           @return A connection object if successful

     

       1414
       1414
       -
           

     

       1415
       1415
       -
           TODO:claude *)

     

       1416
       1416
       -
       let login ~uri ~credentials =

     

       1417
       1417
       -
         let* session_result = get_session (Uri.of_string uri) 

     

       1418
       1418
       -
             ~username:credentials.username 

     

       1419
       1419
       -
             ~authentication_token:credentials.password 

     

       1420
       1420
       -
             () in

     

       1421
       1421
       -
         match session_result with

     

       1422
       1422
       -
         | Ok session ->

     

       1423
       1423
       -
             let api_uri = Uri.of_string session.api_url in

     

       1424
       1424
       -
             let config = {

     

       1425
       1425
       -
               api_uri;

     

       1426
       1426
       -
               username = credentials.username;

     

       1427
       1427
       -
               authentication_token = credentials.password;

     

       1428
       1428
       -
             } in

     

       1429
       1429
       -
             Lwt.return (Ok { session; config })

     

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

     

       1431
       1431
       -
       

     

       1432
       1432
       -
       (** Login to a JMAP server using an API token

     

       1433
       1433
       -
           @param uri The URI of the JMAP server

     

       1434
       1434
       -
           @param api_token The API token for authentication

     

       1435
       1435
       -
           @return A connection object if successful

     

       1436
       1436
       -
           

     

       1437
       1437
       -
           TODO:claude *)

     

       1438
       1438
       -
       let login_with_token ~uri ~api_token =

     

       1439
       1439
       -
         let* session_result = get_session (Uri.of_string uri) 

     

       1440
       1440
       -
             ~api_token 

     

       1441
       1441
       -
             () in

     

       1442
       1442
       -
         match session_result with

     

       1443
       1443
       -
         | Ok session ->

     

       1444
       1444
       -
             let api_uri = Uri.of_string session.api_url in

     

       1445
       1445
       -
             let config = {

     

       1446
       1446
       -
               api_uri;

     

       1447
       1447
       -
               username = ""; (* Empty username indicates we're using token auth *)

     

       1448
       1448
       -
               authentication_token = api_token;

     

       1449
       1449
       -
             } in

     

       1450
       1450
       -
             Lwt.return (Ok { session; config })

     

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

     

       1452
       1452
       -
       

     

       1453
       1453
       -
       (** Get all mailboxes for an account

     

       1454
       1454
       -
           @param conn The JMAP connection

     

       1455
       1455
       -
           @param account_id The account ID to get mailboxes for

     

       1456
       1456
       -
           @return A list of mailboxes if successful

     

       1457
       1457
       -
           

     

       1458
       1458
       -
           TODO:claude *)

     

       1459
       1459
       -
       let get_mailboxes conn ~account_id =

     

       1460
       1460
       -
         let request = {

     

       1461
       1461
       -
           using = [

     

       1462
       1462
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1463
       1463
       -
             Capability.to_string Capability.Mail

     

       1464
       1464
       -
           ];

     

       1465
       1465
       -
           method_calls = [

     

       1466
       1466
       -
             {

     

       1467
       1467
       -
               name = "Mailbox/get";

     

       1468
       1468
       -
               arguments = `O [

     

       1469
       1469
       -
                 ("accountId", `String account_id);

     

       1470
       1470
       -
               ];

     

       1471
       1471
       -
               method_call_id = "m1";

     

       1472
       1472
       -
             }

     

       1473
       1473
       -
           ];

     

       1474
       1474
       -
           created_ids = None;

     

       1475
       1475
       -
         } in

     

       1476
       1476
       -
         

     

       1477
       1477
       -
         let* response_result = make_request conn.config request in

     

       1478
       1478
       -
         match response_result with

     

       1479
       1479
       -
         | Ok response ->

     

       1480
       1480
       -
             let result = 

     

       1481
       1481
       -
               try

     

       1482
       1482
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1483
       1483
       -
                   inv.name = "Mailbox/get") response.method_responses in

     

       1484
       1484
       -
                 let args = method_response.arguments in

     

       1485
       1485
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1486
       1486
       -
                 | Some (`A mailbox_list) ->

     

       1487
       1487
       -
                     let parse_results = List.map mailbox_of_json mailbox_list in

     

       1488
       1488
       -
                     let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1489
       1489
       -
                     if List.length failures > 0 then

     

       1490
       1490
       -
                       Error (Parse_error "Failed to parse some mailboxes")

     

       1491
       1491
       -
                     else

     

       1492
       1492
       -
                       Ok (List.map Result.get_ok successes)

     

       1493
       1493
       -
                 | _ -> Error (Parse_error "Mailbox list not found in response")

     

       1494
       1494
       -
               with

     

       1495
       1495
       -
               | Not_found -> Error (Parse_error "Mailbox/get method response not found")

     

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

     

       1497
       1497
       -
             in

     

       1498
       1498
       -
             Lwt.return result

     

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

     

       1500
       1500
       -
       

     

       1501
       1501
       -
       (** Get a specific mailbox by ID

     

       1502
       1502
       -
           @param conn The JMAP connection

     

       1503
       1503
       -
           @param account_id The account ID

     

       1504
       1504
       -
           @param mailbox_id The mailbox ID to retrieve

     

       1505
       1505
       -
           @return The mailbox if found

     

       1506
       1506
       -
           

     

       1507
       1507
       -
           TODO:claude *)

     

       1508
       1508
       -
       let get_mailbox conn ~account_id ~mailbox_id =

     

       1509
       1509
       -
         let request = {

     

       1510
       1510
       -
           using = [

     

       1511
       1511
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1512
       1512
       -
             Capability.to_string Capability.Mail

     

       1513
       1513
       -
           ];

     

       1514
       1514
       -
           method_calls = [

     

       1515
       1515
       -
             {

     

       1516
       1516
       -
               name = "Mailbox/get";

     

       1517
       1517
       -
               arguments = `O [

     

       1518
       1518
       -
                 ("accountId", `String account_id);

     

       1519
       1519
       -
                 ("ids", `A [`String mailbox_id]);

     

       1520
       1520
       -
               ];

     

       1521
       1521
       -
               method_call_id = "m1";

     

       1522
       1522
       -
             }

     

       1523
       1523
       -
           ];

     

       1524
       1524
       -
           created_ids = None;

     

       1525
       1525
       -
         } in

     

       1526
       1526
       -
         

     

       1527
       1527
       -
         let* response_result = make_request conn.config request in

     

       1528
       1528
       -
         match response_result with

     

       1529
       1529
       -
         | Ok response ->

     

       1530
       1530
       -
             let result = 

     

       1531
       1531
       -
               try

     

       1532
       1532
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1533
       1533
       -
                   inv.name = "Mailbox/get") response.method_responses in

     

       1534
       1534
       -
                 let args = method_response.arguments in

     

       1535
       1535
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1536
       1536
       -
                 | Some (`A [mailbox]) -> mailbox_of_json mailbox

     

       1537
       1537
       -
                 | Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))

     

       1538
       1538
       -
                 | _ -> Error (Parse_error "Expected single mailbox in response")

     

       1539
       1539
       -
               with

     

       1540
       1540
       -
               | Not_found -> Error (Parse_error "Mailbox/get method response not found")

     

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

     

       1542
       1542
       -
             in

     

       1543
       1543
       -
             Lwt.return result

     

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

     

       1545
       1545
       -
       

     

       1546
       1546
       -
       (** Get messages in a mailbox

     

       1547
       1547
       -
           @param conn The JMAP connection

     

       1548
       1548
       -
           @param account_id The account ID

     

       1549
       1549
       -
           @param mailbox_id The mailbox ID to get messages from

     

       1550
       1550
       -
           @param limit Optional limit on number of messages to return

     

       1551
       1551
       -
           @return The list of email messages if successful

     

       1552
       1552
       -
           

     

       1553
       1553
       -
           TODO:claude *)

     

       1554
       1554
       -
       let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =

     

       1555
       1555
       -
         (* First query the emails in the mailbox *)

     

       1556
       1556
       -
         let query_request = {

     

       1557
       1557
       -
           using = [

     

       1558
       1558
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1559
       1559
       -
             Capability.to_string Capability.Mail

     

       1560
       1560
       -
           ];

     

       1561
       1561
       -
           method_calls = [

     

       1562
       1562
       -
             {

     

       1563
       1563
       -
               name = "Email/query";

     

       1564
       1564
       -
               arguments = `O ([

     

       1565
       1565
       -
                 ("accountId", `String account_id);

     

       1566
       1566
       -
                 ("filter", `O [("inMailbox", `String mailbox_id)]);

     

       1567
       1567
       -
                 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);

     

       1568
       1568
       -
               ] @ (match limit with

     

       1569
       1569
       -
                 | Some l -> [("limit", `Float (float_of_int l))]

     

       1570
       1570
       -
                 | None -> []

     

       1571
       1571
       -
               ));

     

       1572
       1572
       -
               method_call_id = "q1";

     

       1573
       1573
       -
             }

     

       1574
       1574
       -
           ];

     

       1575
       1575
       -
           created_ids = None;

     

       1576
       1576
       -
         } in

     

       1577
       1577
       -
         

     

       1578
       1578
       -
         let* query_result = make_request conn.config query_request in

     

       1579
       1579
       -
         match query_result with

     

       1580
       1580
       -
         | Ok query_response ->

     

       1581
       1581
       -
             (try

     

       1582
       1582
       -
                let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1583
       1583
       -
                  inv.name = "Email/query") query_response.method_responses in

     

       1584
       1584
       -
                let args = query_method.arguments in

     

       1585
       1585
       -
                match Ezjsonm.find_opt args ["ids"] with

     

       1586
       1586
       -
                | Some (`A ids) ->

     

       1587
       1587
       -
                    let email_ids = List.map (function 

     

       1588
       1588
       -
                      | `String id -> id 

     

       1589
       1589
       -
                      | _ -> raise (Invalid_argument "Email ID is not a string")

     

       1590
       1590
       -
                    ) ids in

     

       1591
       1591
       -
                    

     

       1592
       1592
       -
                    (* If we have IDs, fetch the actual email objects *)

     

       1593
       1593
       -
                    if List.length email_ids > 0 then

     

       1594
       1594
       -
                      let get_request = {

     

       1595
       1595
       -
                        using = [

     

       1596
       1596
       -
                          Jmap.Capability.to_string Jmap.Capability.Core;

     

       1597
       1597
       -
                          Capability.to_string Capability.Mail

     

       1598
       1598
       -
                        ];

     

       1599
       1599
       -
                        method_calls = [

     

       1600
       1600
       -
                          {

     

       1601
       1601
       -
                            name = "Email/get";

     

       1602
       1602
       -
                            arguments = `O [

     

       1603
       1603
       -
                              ("accountId", `String account_id);

     

       1604
       1604
       -
                              ("ids", `A (List.map (fun id -> `String id) email_ids));

     

       1605
       1605
       -
                            ];

     

       1606
       1606
       -
                            method_call_id = "g1";

     

       1607
       1607
       -
                          }

     

       1608
       1608
       -
                        ];

     

       1609
       1609
       -
                        created_ids = None;

     

       1610
       1610
       -
                      } in

     

       1611
       1611
       -
                      

     

       1612
       1612
       -
                      let* get_result = make_request conn.config get_request in

     

       1613
       1613
       -
                      match get_result with

     

       1614
       1614
       -
                      | Ok get_response -> 

     

       1615
       1615
       -
                          (try

     

       1616
       1616
       -
                             let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1617
       1617
       -
                               inv.name = "Email/get") get_response.method_responses in

     

       1618
       1618
       -
                             let args = get_method.arguments in

     

       1619
       1619
       -
                             match Ezjsonm.find_opt args ["list"] with

     

       1620
       1620
       -
                             | Some (`A email_list) ->

     

       1621
       1621
       -
                                 let parse_results = List.map email_of_json email_list in

     

       1622
       1622
       -
                                 let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1623
       1623
       -
                                 if List.length failures > 0 then

     

       1624
       1624
       -
                                   Lwt.return (Error (Parse_error "Failed to parse some emails"))

     

       1625
       1625
       -
                                 else

     

       1626
       1626
       -
                                   Lwt.return (Ok (List.map Result.get_ok successes))

     

       1627
       1627
       -
                             | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))

     

       1628
       1628
       -
                           with

     

       1629
       1629
       -
                           | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))

     

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

     

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

     

       1632
       1632
       -
                    else

     

       1633
       1633
       -
                      (* No emails in mailbox *)

     

       1634
       1634
       -
                      Lwt.return (Ok [])

     

       1635
       1635
       -
                    

     

       1636
       1636
       -
                | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))

     

       1637
       1637
       -
              with

     

       1638
       1638
       -
              | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))

     

       1639
       1639
       -
              | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))

     

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

     

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

     

       1642
       1642
       -
       

     

       1643
       1643
       -
       (** Get a single email message by ID

     

       1644
       1644
       -
           @param conn The JMAP connection

     

       1645
       1645
       -
           @param account_id The account ID

     

       1646
       1646
       -
           @param email_id The email ID to retrieve

     

       1647
       1647
       -
           @return The email message if found

     

       1648
       1648
       -
           

     

       1649
       1649
       -
           TODO:claude *)

     

       1650
       1650
       -
       let get_email conn ~account_id ~email_id =

     

       1651
       1651
       -
         let request = {

     

       1652
       1652
       -
           using = [

     

       1653
       1653
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1654
       1654
       -
             Capability.to_string Capability.Mail

     

       1655
       1655
       -
           ];

     

       1656
       1656
       -
           method_calls = [

     

       1657
       1657
       -
             {

     

       1658
       1658
       -
               name = "Email/get";

     

       1659
       1659
       -
               arguments = `O [

     

       1660
       1660
       -
                 ("accountId", `String account_id);

     

       1661
       1661
       -
                 ("ids", `A [`String email_id]);

     

       1662
       1662
       -
               ];

     

       1663
       1663
       -
               method_call_id = "m1";

     

       1664
       1664
       -
             }

     

       1665
       1665
       -
           ];

     

       1666
       1666
       -
           created_ids = None;

     

       1667
       1667
       -
         } in

     

       1668
       1668
       -
         

     

       1669
       1669
       -
         let* response_result = make_request conn.config request in

     

       1670
       1670
       -
         match response_result with

     

       1671
       1671
       -
         | Ok response ->

     

       1672
       1672
       -
             let result = 

     

       1673
       1673
       -
               try

     

       1674
       1674
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1675
       1675
       -
                   inv.name = "Email/get") response.method_responses in

     

       1676
       1676
       -
                 let args = method_response.arguments in

     

       1677
       1677
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1678
       1678
       -
                 | Some (`A [email]) -> email_of_json email

     

       1679
       1679
       -
                 | Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))

     

       1680
       1680
       -
                 | _ -> Error (Parse_error "Expected single email in response")

     

       1681
       1681
       -
               with

     

       1682
       1682
       -
               | Not_found -> Error (Parse_error "Email/get method response not found")

     

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

     

       1684
       1684
       -
             in

     

       1685
       1685
       -
             Lwt.return result

     

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

     

       1687
       1687
       -
         

     

       1688
       1688
       -
       (** Helper functions for working with message flags and mailbox attributes *)

     

       1689
       1689
       -
       

     

       1690
       1690
       -
       (** Check if an email has a specific message keyword

     

       1691
       1691
       -
           @param email The email to check

     

       1692
       1692
       -
           @param keyword The message keyword to look for

     

       1693
       1693
       -
           @return true if the email has the keyword, false otherwise

     

       1694
       1694
       -
           

     

       1695
       1695
       -
           TODO:claude *)

     

       1696
       1696
       -
       let has_message_keyword (email:Types.email) keyword =

     

       1697
       1697
       -
         let open Types in

     

       1698
       1698
       -
         let keyword_string = string_of_message_keyword keyword in

     

       1699
       1699
       -
         List.exists (function

     

       1700
       1700
       -
           | (Custom s, true) when s = keyword_string -> true

     

       1701
       1701
       -
           | _ -> false

     

       1702
       1702
       -
         ) email.keywords

     

       1703
       1703
       -
       

     

       1704
       1704
       -
       (** Add a message keyword to an email

     

       1705
       1705
       -
           @param conn The JMAP connection

     

       1706
       1706
       -
           @param account_id The account ID

     

       1707
       1707
       -
           @param email_id The email ID

     

       1708
       1708
       -
           @param keyword The message keyword to add

     

       1709
       1709
       -
           @return Success or error

     

       1710
       1710
       -
           

     

       1711
       1711
       -
           TODO:claude *)

     

       1712
       1712
       -
       let add_message_keyword conn ~account_id ~email_id ~keyword =

     

       1713
       1713
       -
         let keyword_string = Types.string_of_message_keyword keyword in

     

       1714
       1714
       -
         

     

       1715
       1715
       -
         let request = {

     

       1716
       1716
       -
           using = [

     

       1717
       1717
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1718
       1718
       -
             Capability.to_string Capability.Mail

     

       1719
       1719
       -
           ];

     

       1720
       1720
       -
           method_calls = [

     

       1721
       1721
       -
             {

     

       1722
       1722
       -
               name = "Email/set";

     

       1723
       1723
       -
               arguments = `O [

     

       1724
       1724
       -
                 ("accountId", `String account_id);

     

       1725
       1725
       -
                 ("update", `O [

     

       1726
       1726
       -
                   (email_id, `O [

     

       1727
       1727
       -
                     ("keywords", `O [

     

       1728
       1728
       -
                       (keyword_string, `Bool true)

     

       1729
       1729
       -
                     ])

     

       1730
       1730
       -
                   ])

     

       1731
       1731
       -
                 ]);

     

       1732
       1732
       -
               ];

     

       1733
       1733
       -
               method_call_id = "m1";

     

       1734
       1734
       -
             }

     

       1735
       1735
       -
           ];

     

       1736
       1736
       -
           created_ids = None;

     

       1737
       1737
       -
         } in

     

       1738
       1738
       -
         

     

       1739
       1739
       -
         let* response_result = make_request conn.config request in

     

       1740
       1740
       -
         match response_result with

     

       1741
       1741
       -
         | Ok response ->

     

       1742
       1742
       -
             let result = 

     

       1743
       1743
       -
               try

     

       1744
       1744
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1745
       1745
       -
                   inv.name = "Email/set") response.method_responses in

     

       1746
       1746
       -
                 let args = method_response.arguments in

     

       1747
       1747
       -
                 match Ezjsonm.find_opt args ["updated"] with

     

       1748
       1748
       -
                 | Some (`A _ids) -> Ok ()

     

       1749
       1749
       -
                 | _ -> 

     

       1750
       1750
       -
                     match Ezjsonm.find_opt args ["notUpdated"] with

     

       1751
       1751
       -
                     | Some (`O _errors) -> 

     

       1752
       1752
       -
                         Error (Parse_error ("Failed to update email: " ^ email_id))

     

       1753
       1753
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       1754
       1754
       -
               with

     

       1755
       1755
       -
               | Not_found -> Error (Parse_error "Email/set method response not found")

     

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

     

       1757
       1757
       -
             in

     

       1758
       1758
       -
             Lwt.return result

     

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

     

       1760
       1760
       -
       

     

       1761
       1761
       -
       (** Set a flag color for an email

     

       1762
       1762
       -
           @param conn The JMAP connection

     

       1763
       1763
       -
           @param account_id The account ID

     

       1764
       1764
       -
           @param email_id The email ID

     

       1765
       1765
       -
           @param color The flag color to set

     

       1766
       1766
       -
           @return Success or error

     

       1767
       1767
       -
           

     

       1768
       1768
       -
           TODO:claude *)

     

       1769
       1769
       -
       let set_flag_color conn ~account_id ~email_id ~color =

     

       1770
       1770
       -
         (* Get the bit pattern for the color *)

     

       1771
       1771
       -
         let (bit0, bit1, bit2) = Types.bits_of_flag_color color in

     

       1772
       1772
       -
         

     

       1773
       1773
       -
         (* Build the keywords update object *)

     

       1774
       1774
       -
         let keywords = [

     

       1775
       1775
       -
           ("$flagged", `Bool true);

     

       1776
       1776
       -
           ("$MailFlagBit0", `Bool bit0);

     

       1777
       1777
       -
           ("$MailFlagBit1", `Bool bit1);

     

       1778
       1778
       -
           ("$MailFlagBit2", `Bool bit2);

     

       1779
       1779
       -
         ] in

     

       1780
       1780
       -
         

     

       1781
       1781
       -
         let request = {

     

       1782
       1782
       -
           using = [

     

       1783
       1783
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1784
       1784
       -
             Capability.to_string Capability.Mail

     

       1785
       1785
       -
           ];

     

       1786
       1786
       -
           method_calls = [

     

       1787
       1787
       -
             {

     

       1788
       1788
       -
               name = "Email/set";

     

       1789
       1789
       -
               arguments = `O [

     

       1790
       1790
       -
                 ("accountId", `String account_id);

     

       1791
       1791
       -
                 ("update", `O [

     

       1792
       1792
       -
                   (email_id, `O [

     

       1793
       1793
       -
                     ("keywords", `O keywords)

     

       1794
       1794
       -
                   ])

     

       1795
       1795
       -
                 ]);

     

       1796
       1796
       -
               ];

     

       1797
       1797
       -
               method_call_id = "m1";

     

       1798
       1798
       -
             }

     

       1799
       1799
       -
           ];

     

       1800
       1800
       -
           created_ids = None;

     

       1801
       1801
       -
         } in

     

       1802
       1802
       -
         

     

       1803
       1803
       -
         let* response_result = make_request conn.config request in

     

       1804
       1804
       -
         match response_result with

     

       1805
       1805
       -
         | Ok response ->

     

       1806
       1806
       -
             let result = 

     

       1807
       1807
       -
               try

     

       1808
       1808
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1809
       1809
       -
                   inv.name = "Email/set") response.method_responses in

     

       1810
       1810
       -
                 let args = method_response.arguments in

     

       1811
       1811
       -
                 match Ezjsonm.find_opt args ["updated"] with

     

       1812
       1812
       -
                 | Some (`A _ids) -> Ok ()

     

       1813
       1813
       -
                 | _ -> 

     

       1814
       1814
       -
                     match Ezjsonm.find_opt args ["notUpdated"] with

     

       1815
       1815
       -
                     | Some (`O _errors) -> 

     

       1816
       1816
       -
                         Error (Parse_error ("Failed to update email: " ^ email_id))

     

       1817
       1817
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       1818
       1818
       -
               with

     

       1819
       1819
       -
               | Not_found -> Error (Parse_error "Email/set method response not found")

     

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

     

       1821
       1821
       -
             in

     

       1822
       1822
       -
             Lwt.return result

     

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

     

       1824
       1824
       -
       

     

       1825
       1825
       -
       (** Convert an email's keywords to typed message_keyword list

     

       1826
       1826
       -
           @param email The email to analyze

     

       1827
       1827
       -
           @return List of message keywords

     

       1828
       1828
       -
           

     

       1829
       1829
       -
           TODO:claude *)

     

       1830
       1830
       -
       let get_message_keywords (email:Types.email) =

     

       1831
       1831
       -
         let open Types in

     

       1832
       1832
       -
         List.filter_map (function

     

       1833
       1833
       -
           | (Custom s, true) -> Some (message_keyword_of_string s)

     

       1834
       1834
       -
           | _ -> None

     

       1835
       1835
       -
         ) email.keywords

     

       1836
       1836
       -
       

     

       1837
       1837
       -
       (** Get emails with a specific message keyword

     

       1838
       1838
       -
           @param conn The JMAP connection

     

       1839
       1839
       -
           @param account_id The account ID

     

       1840
       1840
       -
           @param keyword The message keyword to search for

     

       1841
       1841
       -
           @param limit Optional limit on number of emails to return

     

       1842
       1842
       -
           @return List of emails with the keyword if successful

     

       1843
       1843
       -
           

     

       1844
       1844
       -
           TODO:claude *)

     

       1845
       1845
       -
       let get_emails_with_keyword conn ~account_id ~keyword ?limit () =

     

       1846
       1846
       -
         let keyword_string = Types.string_of_message_keyword keyword in

     

       1847
       1847
       -
         

     

       1848
       1848
       -
         (* Query for emails with the specified keyword *)

     

       1849
       1849
       -
         let query_request = {

     

       1850
       1850
       -
           using = [

     

       1851
       1851
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1852
       1852
       -
             Capability.to_string Capability.Mail

     

       1853
       1853
       -
           ];

     

       1854
       1854
       -
           method_calls = [

     

       1855
       1855
       -
             {

     

       1856
       1856
       -
               name = "Email/query";

     

       1857
       1857
       -
               arguments = `O ([

     

       1858
       1858
       -
                 ("accountId", `String account_id);

     

       1859
       1859
       -
                 ("filter", `O [("hasKeyword", `String keyword_string)]);

     

       1860
       1860
       -
                 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);

     

       1861
       1861
       -
               ] @ (match limit with

     

       1862
       1862
       -
                 | Some l -> [("limit", `Float (float_of_int l))]

     

       1863
       1863
       -
                 | None -> []

     

       1864
       1864
       -
               ));

     

       1865
       1865
       -
               method_call_id = "q1";

     

       1866
       1866
       -
             }

     

       1867
       1867
       -
           ];

     

       1868
       1868
       -
           created_ids = None;

     

       1869
       1869
       -
         } in

     

       1870
       1870
       -
         

     

       1871
       1871
       -
         let* query_result = make_request conn.config query_request in

     

       1872
       1872
       -
         match query_result with

     

       1873
       1873
       -
         | Ok query_response ->

     

       1874
       1874
       -
             (try

     

       1875
       1875
       -
                let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1876
       1876
       -
                  inv.name = "Email/query") query_response.method_responses in

     

       1877
       1877
       -
                let args = query_method.arguments in

     

       1878
       1878
       -
                match Ezjsonm.find_opt args ["ids"] with

     

       1879
       1879
       -
                | Some (`A ids) ->

     

       1880
       1880
       -
                    let email_ids = List.map (function 

     

       1881
       1881
       -
                      | `String id -> id 

     

       1882
       1882
       -
                      | _ -> raise (Invalid_argument "Email ID is not a string")

     

       1883
       1883
       -
                    ) ids in

     

       1884
       1884
       -
                    

     

       1885
       1885
       -
                    (* If we have IDs, fetch the actual email objects *)

     

       1886
       1886
       -
                    if List.length email_ids > 0 then

     

       1887
       1887
       -
                      let get_request = {

     

       1888
       1888
       -
                        using = [

     

       1889
       1889
       -
                          Jmap.Capability.to_string Jmap.Capability.Core;

     

       1890
       1890
       -
                          Capability.to_string Capability.Mail

     

       1891
       1891
       -
                        ];

     

       1892
       1892
       -
                        method_calls = [

     

       1893
       1893
       -
                          {

     

       1894
       1894
       -
                            name = "Email/get";

     

       1895
       1895
       -
                            arguments = `O [

     

       1896
       1896
       -
                              ("accountId", `String account_id);

     

       1897
       1897
       -
                              ("ids", `A (List.map (fun id -> `String id) email_ids));

     

       1898
       1898
       -
                            ];

     

       1899
       1899
       -
                            method_call_id = "g1";

     

       1900
       1900
       -
                          }

     

       1901
       1901
       -
                        ];

     

       1902
       1902
       -
                        created_ids = None;

     

       1903
       1903
       -
                      } in

     

       1904
       1904
       -
                      

     

       1905
       1905
       -
                      let* get_result = make_request conn.config get_request in

     

       1906
       1906
       -
                      match get_result with

     

       1907
       1907
       -
                      | Ok get_response -> 

     

       1908
       1908
       -
                          (try

     

       1909
       1909
       -
                             let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1910
       1910
       -
                               inv.name = "Email/get") get_response.method_responses in

     

       1911
       1911
       -
                             let args = get_method.arguments in

     

       1912
       1912
       -
                             match Ezjsonm.find_opt args ["list"] with

     

       1913
       1913
       -
                             | Some (`A email_list) ->

     

       1914
       1914
       -
                                 let parse_results = List.map email_of_json email_list in

     

       1915
       1915
       -
                                 let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1916
       1916
       -
                                 if List.length failures > 0 then

     

       1917
       1917
       -
                                   Lwt.return (Error (Parse_error "Failed to parse some emails"))

     

       1918
       1918
       -
                                 else

     

       1919
       1919
       -
                                   Lwt.return (Ok (List.map Result.get_ok successes))

     

       1920
       1920
       -
                             | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))

     

       1921
       1921
       -
                           with

     

       1922
       1922
       -
                           | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))

     

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

     

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

     

       1925
       1925
       -
                    else

     

       1926
       1926
       -
                      (* No emails with the keyword *)

     

       1927
       1927
       -
                      Lwt.return (Ok [])

     

       1928
       1928
       -
                    

     

       1929
       1929
       -
                | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))

     

       1930
       1930
       -
              with

     

       1931
       1931
       -
              | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))

     

       1932
       1932
       -
              | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))

     

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

     

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

     

       1935
       1935
       -
       

     

       1936
       1936
       -
       (** {1 Email Address Utilities} *)

     

       1937
       1937
       -
       

     

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

     

       1939
       1939
       -
       let contains_substring str sub =

     

       1940
       1940
       -
         try 

     

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

     

       1942
       1942
       -
           true

     

       1943
       1943
       -
         with Not_found -> false

     

       1944
       1944
       -
       

     

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

     

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

     

       1947
       1947
       -
           @param str String to match against

     

       1948
       1948
       -
           Based on simple recursive wildcard matching algorithm

     

       1949
       1949
       -
       *)

     

       1950
       1950
       -
       let matches_wildcard pattern str =

     

       1951
       1951
       -
         let pattern_len = String.length pattern in

     

       1952
       1952
       -
         let str_len = String.length str in

     

       1953
       1953
       -
         

     

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

     

       1955
       1955
       -
         let pattern = String.lowercase_ascii pattern in

     

       1956
       1956
       -
         let str = String.lowercase_ascii str in

     

       1957
       1957
       -
         

     

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

     

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

     

       1960
       1960
       -
           contains_substring str pattern

     

       1961
       1961
       -
         else

     

       1962
       1962
       -
           (* Classic recursive matching algorithm *)

     

       1963
       1963
       -
           let rec match_from p_pos s_pos =

     

       1964
       1964
       -
             (* Pattern matched to the end *)

     

       1965
       1965
       -
             if p_pos = pattern_len then

     

       1966
       1966
       -
               s_pos = str_len

     

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

     

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

     

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

     

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

     

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

     

       1972
       1972
       -
             else if s_pos < str_len && 

     

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

     

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

     

       1975
       1975
       -
             else

     

       1976
       1976
       -
               false

     

       1977
       1977
       -
           in

     

       1978
       1978
       -
           

     

       1979
       1979
       -
           match_from 0 0

     

       1980
       1980
       -
       

     

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

     

       1982
       1982
       -
           @param email The email address to check

     

       1983
       1983
       -
           @param pattern The filter pattern to match against

     

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

     

       1985
       1985
       -
       *)

     

       1986
       1986
       -
       let email_address_matches email pattern =

     

       1987
       1987
       -
         matches_wildcard pattern email

     

       1988
       1988
       -
       

     

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

     

       1990
       1990
       -
           @param email The email object to check

     

       1991
       1991
       -
           @param pattern The sender filter pattern

     

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

     

       1993
       1993
       -
       *)

     

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

     

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

     

       1996
       1996
       -
         let addresses_match addrs =

     

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

     

       1998
       1998
       -
             email_address_matches addr.email pattern

     

       1999
       1999
       -
           ) addrs

     

       2000
       2000
       -
         in

     

       2001
       2001
       -
         

     

       2002
       2002
       -
         (* Check From addresses first *)

     

       2003
       2003
       -
         let from_match = 

     

       2004
       2004
       -
           match email.Types.from with

     

       2005
       2005
       -
           | Some addrs -> addresses_match addrs

     

       2006
       2006
       -
           | None -> false

     

       2007
       2007
       -
         in

     

       2008
       2008
       -
         

     

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

     

       2010
       2010
       -
         if from_match then true

     

       2011
       2011
       -
         else

     

       2012
       2012
       -
           match email.Types.sender with

     

       2013
       2013
       -
           | Some addrs -> addresses_match addrs

     

       2014
       2014
       -
           | None -> false

-1542

lib/jmap_mail.mli

···

       1
       1
       -
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 

     

       2
       2
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621> RFC8621

     

       3
       3
       -
           

     

       4
       4
       -
           This module implements the JMAP Mail specification, providing types and

     

       5
       5
       -
           functions for working with emails, mailboxes, threads, and other mail-related

     

       6
       6
       -
           objects in the JMAP protocol.

     

       7
       7
       -
       *)

     

       8
       8
       -
       

     

       9
       9
       -
       (** Module for managing JMAP Mail-specific capability URIs as defined in RFC8621 Section 1.3

     

       10
       10
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3> RFC8621 Section 1.3

     

       11
       11
       -
       *)

     

       12
       12
       -
       module Capability : sig

     

       13
       13
       -
         (** Mail capability URI as defined in RFC8621 Section 1.3

     

       14
       14
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       15
       15
       -
         *)

     

       16
       16
       -
         val mail_uri : string

     

       17
       17
       -
       

     

       18
       18
       -
         (** Submission capability URI as defined in RFC8621 Section 1.3

     

       19
       19
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       20
       20
       -
         *)

     

       21
       21
       -
         val submission_uri : string

     

       22
       22
       -
       

     

       23
       23
       -
         (** Vacation response capability URI as defined in RFC8621 Section 1.3

     

       24
       24
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       25
       25
       -
         *)

     

       26
       26
       -
         val vacation_response_uri : string

     

       27
       27
       -
       

     

       28
       28
       -
         (** All mail extension capability types as defined in RFC8621 Section 1.3

     

       29
       29
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       30
       30
       -
         *)

     

       31
       31
       -
         type t =

     

       32
       32
       -
           | Mail            (** Mail capability for emails and mailboxes *)

     

       33
       33
       -
           | Submission      (** Submission capability for sending emails *)

     

       34
       34
       -
           | VacationResponse (** Vacation response capability for auto-replies *)

     

       35
       35
       -
           | Extension of string (** Custom extension capabilities *)

     

       36
       36
       -
       

     

       37
       37
       -
         (** Convert capability to URI string

     

       38
       38
       -
             @param capability The capability to convert

     

       39
       39
       -
             @return The full URI string for the capability

     

       40
       40
       -
         *)

     

       41
       41
       -
         val to_string : t -> string

     

       42
       42
       -
       

     

       43
       43
       -
         (** Parse a string to a capability

     

       44
       44
       -
             @param uri The capability URI string to parse

     

       45
       45
       -
             @return The parsed capability type

     

       46
       46
       -
         *)

     

       47
       47
       -
         val of_string : string -> t

     

       48
       48
       -
       

     

       49
       49
       -
         (** Check if a capability is a standard mail capability

     

       50
       50
       -
             @param capability The capability to check

     

       51
       51
       -
             @return True if the capability is a standard JMAP Mail capability

     

       52
       52
       -
         *)

     

       53
       53
       -
         val is_standard : t -> bool

     

       54
       54
       -
       

     

       55
       55
       -
         (** Check if a capability string is a standard mail capability

     

       56
       56
       -
             @param uri The capability URI string to check

     

       57
       57
       -
             @return True if the string represents a standard JMAP Mail capability

     

       58
       58
       -
         *)

     

       59
       59
       -
         val is_standard_string : string -> bool

     

       60
       60
       -
       

     

       61
       61
       -
         (** Create a list of capability strings

     

       62
       62
       -
             @param capabilities List of capability types

     

       63
       63
       -
             @return List of capability URI strings

     

       64
       64
       -
         *)

     

       65
       65
       -
         val strings_of_capabilities : t list -> string list

     

       66
       66
       -
       end

     

       67
       67
       -
       

     

       68
       68
       -
       (** Types for the JMAP Mail extension as defined in RFC8621

     

       69
       69
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621>

     

       70
       70
       -
       *)

     

       71
       71
       -
       module Types : sig

     

       72
       72
       -
         open Jmap.Types

     

       73
       73
       -
       

     

       74
       74
       -
         (** {1 Mail capabilities}

     

       75
       75
       -
             Capability URIs for JMAP Mail extension as defined in RFC8621 Section 1.3

     

       76
       76
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       77
       77
       -
         *)

     

       78
       78
       -
       

     

       79
       79
       -
         (** Capability URI for JMAP Mail as defined in RFC8621 Section 1.3

     

       80
       80
       -
             Identifies support for the Mail data model

     

       81
       81
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       82
       82
       -
         *)

     

       83
       83
       -
         val capability_mail : string

     

       84
       84
       -
       

     

       85
       85
       -
         (** Capability URI for JMAP Submission as defined in RFC8621 Section 1.3

     

       86
       86
       -
             Identifies support for email submission

     

       87
       87
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       88
       88
       -
         *)

     

       89
       89
       -
         val capability_submission : string

     

       90
       90
       -
         

     

       91
       91
       -
         (** Capability URI for JMAP Vacation Response as defined in RFC8621 Section 1.3

     

       92
       92
       -
             Identifies support for vacation auto-reply functionality

     

       93
       93
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       94
       94
       -
         *)

     

       95
       95
       -
         val capability_vacation_response : string

     

       96
       96
       -
       

     

       97
       97
       -
         (** {1:mailbox Mailbox objects}

     

       98
       98
       -
             Mailbox types as defined in RFC8621 Section 2

     

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

     

       100
       100
       -
         *)

     

       101
       101
       -
       

     

       102
       102
       -
         (** A role for a mailbox as defined in RFC8621 Section 2.

     

       103
       103
       -
             Standardized roles for special mailboxes like Inbox, Sent, etc.

     

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

     

       105
       105
       -
         *)

     

       106
       106
       -
         type mailbox_role =

     

       107
       107
       -
           | All (** All mail mailbox *)

     

       108
       108
       -
           | Archive (** Archived mail mailbox *)

     

       109
       109
       -
           | Drafts (** Draft messages mailbox *)

     

       110
       110
       -
           | Flagged (** Starred/flagged mail mailbox *)

     

       111
       111
       -
           | Important (** Important mail mailbox *)

     

       112
       112
       -
           | Inbox (** Primary inbox mailbox *)

     

       113
       113
       -
           | Junk (** Spam/Junk mail mailbox *)

     

       114
       114
       -
           | Sent (** Sent mail mailbox *)

     

       115
       115
       -
           | Trash (** Deleted/Trash mail mailbox *)

     

       116
       116
       -
           | Unknown of string (** Server-specific custom roles *)

     

       117
       117
       -
         

     

       118
       118
       -
         (** A mailbox (folder) in a mail account as defined in RFC8621 Section 2.

     

       119
       119
       -
             Represents an email folder or label in the account.

     

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

     

       121
       121
       -
         *)

     

       122
       122
       -
         type mailbox = {

     

       123
       123
       -
           id : id;  (** Server-assigned ID for the mailbox *)

     

       124
       124
       -
           name : string;  (** User-visible name for the mailbox *)

     

       125
       125
       -
           parent_id : id option;  (** ID of the parent mailbox, if any *)

     

       126
       126
       -
           role : mailbox_role option;  (** The role of this mailbox, if it's a special mailbox *)

     

       127
       127
       -
           sort_order : unsigned_int;  (** Position for mailbox in the UI *)

     

       128
       128
       -
           total_emails : unsigned_int;  (** Total number of emails in the mailbox *)

     

       129
       129
       -
           unread_emails : unsigned_int;  (** Number of unread emails in the mailbox *)

     

       130
       130
       -
           total_threads : unsigned_int;  (** Total number of threads in the mailbox *)

     

       131
       131
       -
           unread_threads : unsigned_int;  (** Number of threads with unread emails *)

     

       132
       132
       -
           is_subscribed : bool;  (** Has the user subscribed to this mailbox *)

     

       133
       133
       -
           my_rights : mailbox_rights;  (** Access rights for the user on this mailbox *)

     

       134
       134
       -
         }

     

       135
       135
       -
       

     

       136
       136
       -
         (** Rights for a mailbox as defined in RFC8621 Section 2.

     

       137
       137
       -
             Determines the operations a user can perform on a mailbox.

     

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

     

       139
       139
       -
         *)

     

       140
       140
       -
         and mailbox_rights = {

     

       141
       141
       -
           may_read_items : bool;  (** Can the user read messages in this mailbox *)

     

       142
       142
       -
           may_add_items : bool;  (** Can the user add messages to this mailbox *)

     

       143
       143
       -
           may_remove_items : bool;  (** Can the user remove messages from this mailbox *)

     

       144
       144
       -
           may_set_seen : bool;  (** Can the user mark messages as read/unread *)

     

       145
       145
       -
           may_set_keywords : bool;  (** Can the user set keywords/flags on messages *)

     

       146
       146
       -
           may_create_child : bool;  (** Can the user create child mailboxes *)

     

       147
       147
       -
           may_rename : bool;  (** Can the user rename this mailbox *)

     

       148
       148
       -
           may_delete : bool;  (** Can the user delete this mailbox *)

     

       149
       149
       -
           may_submit : bool;  (** Can the user submit messages in this mailbox for delivery *)

     

       150
       150
       -
         }

     

       151
       151
       -
       

     

       152
       152
       -
         (** Filter condition for mailbox queries as defined in RFC8621 Section 2.3.

     

       153
       153
       -
             Used to filter mailboxes in queries.

     

       154
       154
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       155
       155
       -
         *)

     

       156
       156
       -
         type mailbox_filter_condition = {

     

       157
       157
       -
           parent_id : id option;  (** Only include mailboxes with this parent *)

     

       158
       158
       -
           name : string option;  (** Only include mailboxes with this name (case-insensitive substring match) *)

     

       159
       159
       -
           role : string option;  (** Only include mailboxes with this role *)

     

       160
       160
       -
           has_any_role : bool option;  (** If true, only include mailboxes with a role, if false those without *)

     

       161
       161
       -
           is_subscribed : bool option;  (** If true, only include subscribed mailboxes, if false unsubscribed *)

     

       162
       162
       -
         }

     

       163
       163
       -
       

     

       164
       164
       -
         (** Filter for mailbox queries as defined in RFC8621 Section 2.3.

     

       165
       165
       -
             Complex filter for Mailbox/query method.

     

       166
       166
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       167
       167
       -
         *)

     

       168
       168
       -
         type mailbox_query_filter = [

     

       169
       169
       -
           | `And of mailbox_query_filter list  (** Logical AND of filters *)

     

       170
       170
       -
           | `Or of mailbox_query_filter list   (** Logical OR of filters *)

     

       171
       171
       -
           | `Not of mailbox_query_filter       (** Logical NOT of a filter *)

     

       172
       172
       -
           | `Condition of mailbox_filter_condition  (** Simple condition filter *)

     

       173
       173
       -
         ]

     

       174
       174
       -
       

     

       175
       175
       -
         (** Mailbox/get request arguments as defined in RFC8621 Section 2.1.

     

       176
       176
       -
             Used to fetch mailboxes by ID.

     

       177
       177
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>

     

       178
       178
       -
         *)

     

       179
       179
       -
         type mailbox_get_arguments = {

     

       180
       180
       -
           account_id : id;  (** The account to fetch mailboxes from *)

     

       181
       181
       -
           ids : id list option;  (** The IDs of mailboxes to fetch, null means all *)

     

       182
       182
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       183
       183
       -
         }

     

       184
       184
       -
       

     

       185
       185
       -
         (** Mailbox/get response as defined in RFC8621 Section 2.1.

     

       186
       186
       -
             Contains requested mailboxes.

     

       187
       187
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>

     

       188
       188
       -
         *)

     

       189
       189
       -
         type mailbox_get_response = {

     

       190
       190
       -
           account_id : id;  (** The account from which mailboxes were fetched *)

     

       191
       191
       -
           state : string;  (** A string representing the state on the server *)

     

       192
       192
       -
           list : mailbox list;  (** The list of mailboxes requested *)

     

       193
       193
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       194
       194
       -
         }

     

       195
       195
       -
       

     

       196
       196
       -
         (** Mailbox/changes request arguments as defined in RFC8621 Section 2.2.

     

       197
       197
       -
             Used to get mailbox changes since a previous state.

     

       198
       198
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>

     

       199
       199
       -
         *)

     

       200
       200
       -
         type mailbox_changes_arguments = {

     

       201
       201
       -
           account_id : id;  (** The account to get changes for *)

     

       202
       202
       -
           since_state : string;  (** The previous state to compare to *)

     

       203
       203
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       204
       204
       -
         }

     

       205
       205
       -
       

     

       206
       206
       -
         (** Mailbox/changes response as defined in RFC8621 Section 2.2.

     

       207
       207
       -
             Reports mailboxes that have changed since a previous state.

     

       208
       208
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>

     

       209
       209
       -
         *)

     

       210
       210
       -
         type mailbox_changes_response = {

     

       211
       211
       -
           account_id : id;  (** The account changes are for *)

     

       212
       212
       -
           old_state : string;  (** The state provided in the request *)

     

       213
       213
       -
           new_state : string;  (** The current state on the server *)

     

       214
       214
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       215
       215
       -
           created : id list;  (** IDs of mailboxes created since old_state *)

     

       216
       216
       -
           updated : id list;  (** IDs of mailboxes updated since old_state *)

     

       217
       217
       -
           destroyed : id list;  (** IDs of mailboxes destroyed since old_state *)

     

       218
       218
       -
         }

     

       219
       219
       -
       

     

       220
       220
       -
         (** Mailbox/query request arguments as defined in RFC8621 Section 2.3.

     

       221
       221
       -
             Used to query mailboxes based on filter criteria.

     

       222
       222
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       223
       223
       -
         *)

     

       224
       224
       -
         type mailbox_query_arguments = {

     

       225
       225
       -
           account_id : id;  (** The account to query *)

     

       226
       226
       -
           filter : mailbox_query_filter option;  (** Filter to match mailboxes against *)

     

       227
       227
       -
           sort : [ `name | `role | `sort_order ] list option;  (** Sort criteria *)

     

       228
       228
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       229
       229
       -
         }

     

       230
       230
       -
       

     

       231
       231
       -
         (** Mailbox/query response as defined in RFC8621 Section 2.3.

     

       232
       232
       -
             Contains IDs of mailboxes matching the query.

     

       233
       233
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       234
       234
       -
         *)

     

       235
       235
       -
         type mailbox_query_response = {

     

       236
       236
       -
           account_id : id;  (** The account that was queried *)

     

       237
       237
       -
           query_state : string;  (** State string for the query results *)

     

       238
       238
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       239
       239
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       240
       240
       -
           ids : id list;  (** IDs of mailboxes matching the query *)

     

       241
       241
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       242
       242
       -
         }

     

       243
       243
       -
       

     

       244
       244
       -
         (** Mailbox/queryChanges request arguments as defined in RFC8621 Section 2.4.

     

       245
       245
       -
             Used to get changes to mailbox query results.

     

       246
       246
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       247
       247
       -
         *)

     

       248
       248
       -
         type mailbox_query_changes_arguments = {

     

       249
       249
       -
           account_id : id;  (** The account to query *)

     

       250
       250
       -
           filter : mailbox_query_filter option;  (** Same filter as the original query *)

     

       251
       251
       -
           sort : [ `name | `role | `sort_order ] list option;  (** Same sort as the original query *)

     

       252
       252
       -
           since_query_state : string;  (** The query_state from the previous result *)

     

       253
       253
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       254
       254
       -
           up_to_id : id option;  (** ID of the last mailbox to check for changes *)

     

       255
       255
       -
         }

     

       256
       256
       -
       

     

       257
       257
       -
         (** Mailbox/queryChanges response as defined in RFC8621 Section 2.4.

     

       258
       258
       -
             Reports changes to a mailbox query since the previous state.

     

       259
       259
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       260
       260
       -
         *)

     

       261
       261
       -
         type mailbox_query_changes_response = {

     

       262
       262
       -
           account_id : id;  (** The account that was queried *)

     

       263
       263
       -
           old_query_state : string;  (** The query_state from the request *)

     

       264
       264
       -
           new_query_state : string;  (** The current query_state on the server *)

     

       265
       265
       -
           total : unsigned_int option;  (** Updated total number of matches, if requested *)

     

       266
       266
       -
           removed : id list;  (** IDs that were in the old results but not the new *)

     

       267
       267
       -
           added : mailbox_query_changes_added list;  (** IDs that are in the new results but not the old *)

     

       268
       268
       -
         }

     

       269
       269
       -
       

     

       270
       270
       -
         (** Added item in mailbox query changes as defined in RFC8621 Section 2.4.

     

       271
       271
       -
             Represents a mailbox added to query results.

     

       272
       272
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       273
       273
       -
         *)

     

       274
       274
       -
         and mailbox_query_changes_added = {

     

       275
       275
       -
           id : id;  (** ID of the added mailbox *)

     

       276
       276
       -
           index : unsigned_int;  (** Zero-based index of the added mailbox in the results *)

     

       277
       277
       -
         }

     

       278
       278
       -
       

     

       279
       279
       -
         (** Mailbox/set request arguments as defined in RFC8621 Section 2.5.

     

       280
       280
       -
             Used to create, update, and destroy mailboxes.

     

       281
       281
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       282
       282
       -
         *)

     

       283
       283
       -
         type mailbox_set_arguments = {

     

       284
       284
       -
           account_id : id;  (** The account to make changes in *)

     

       285
       285
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       286
       286
       -
           create : (id * mailbox_creation) list option;  (** Map of creation IDs to mailboxes to create *)

     

       287
       287
       -
           update : (id * mailbox_update) list option;  (** Map of IDs to update properties *)

     

       288
       288
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       289
       289
       -
         }

     

       290
       290
       -
       

     

       291
       291
       -
         (** Properties for mailbox creation as defined in RFC8621 Section 2.5.

     

       292
       292
       -
             Used to create new mailboxes.

     

       293
       293
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       294
       294
       -
         *)

     

       295
       295
       -
         and mailbox_creation = {

     

       296
       296
       -
           name : string;  (** Name for the new mailbox *)

     

       297
       297
       -
           parent_id : id option;  (** ID of the parent mailbox, if any *)

     

       298
       298
       -
           role : string option;  (** Role for the mailbox, if it's a special-purpose mailbox *)

     

       299
       299
       -
           sort_order : unsigned_int option;  (** Sort order, defaults to 0 *)

     

       300
       300
       -
           is_subscribed : bool option;  (** Whether the mailbox is subscribed, defaults to true *)

     

       301
       301
       -
         }

     

       302
       302
       -
       

     

       303
       303
       -
         (** Properties for mailbox update as defined in RFC8621 Section 2.5.

     

       304
       304
       -
             Used to update existing mailboxes.

     

       305
       305
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       306
       306
       -
         *)

     

       307
       307
       -
         and mailbox_update = {

     

       308
       308
       -
           name : string option;  (** New name for the mailbox *)

     

       309
       309
       -
           parent_id : id option;  (** New parent ID for the mailbox *)

     

       310
       310
       -
           role : string option;  (** New role for the mailbox *)

     

       311
       311
       -
           sort_order : unsigned_int option;  (** New sort order for the mailbox *)

     

       312
       312
       -
           is_subscribed : bool option;  (** New subscription status for the mailbox *)

     

       313
       313
       -
         }

     

       314
       314
       -
       

     

       315
       315
       -
         (** Mailbox/set response as defined in RFC8621 Section 2.5.

     

       316
       316
       -
             Reports the results of mailbox changes.

     

       317
       317
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       318
       318
       -
         *)

     

       319
       319
       -
         type mailbox_set_response = {

     

       320
       320
       -
           account_id : id;  (** The account that was modified *)

     

       321
       321
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       322
       322
       -
           new_state : string;  (** The current state on the server *)

     

       323
       323
       -
           created : (id * mailbox) list option;  (** Map of creation IDs to created mailboxes *)

     

       324
       324
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       325
       325
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       326
       326
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       327
       327
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       328
       328
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       329
       329
       -
         }

     

       330
       330
       -
       

     

       331
       331
       -
         (** {1:thread Thread objects}

     

       332
       332
       -
             Thread types as defined in RFC8621 Section 3

     

       333
       333
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>

     

       334
       334
       -
         *)

     

       335
       335
       -
       

     

       336
       336
       -
         (** A thread in a mail account as defined in RFC8621 Section 3.

     

       337
       337
       -
             Represents a group of related email messages.

     

       338
       338
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>

     

       339
       339
       -
         *)

     

       340
       340
       -
         type thread = {

     

       341
       341
       -
           id : id;  (** Server-assigned ID for the thread *)

     

       342
       342
       -
           email_ids : id list;  (** IDs of emails in the thread *)

     

       343
       343
       -
         }

     

       344
       344
       -
       

     

       345
       345
       -
         (** Thread/get request arguments as defined in RFC8621 Section 3.1.

     

       346
       346
       -
             Used to fetch threads by ID.

     

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

     

       348
       348
       -
         *)

     

       349
       349
       -
         type thread_get_arguments = {

     

       350
       350
       -
           account_id : id;  (** The account to fetch threads from *)

     

       351
       351
       -
           ids : id list option;  (** The IDs of threads to fetch, null means all *)

     

       352
       352
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       353
       353
       -
         }

     

       354
       354
       -
       

     

       355
       355
       -
         (** Thread/get response as defined in RFC8621 Section 3.1.

     

       356
       356
       -
             Contains requested threads.

     

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

     

       358
       358
       -
         *)

     

       359
       359
       -
         type thread_get_response = {

     

       360
       360
       -
           account_id : id;  (** The account from which threads were fetched *)

     

       361
       361
       -
           state : string;  (** A string representing the state on the server *)

     

       362
       362
       -
           list : thread list;  (** The list of threads requested *)

     

       363
       363
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       364
       364
       -
         }

     

       365
       365
       -
       

     

       366
       366
       -
         (** Thread/changes request arguments as defined in RFC8621 Section 3.2.

     

       367
       367
       -
             Used to get thread changes since a previous state.

     

       368
       368
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>

     

       369
       369
       -
         *)

     

       370
       370
       -
         type thread_changes_arguments = {

     

       371
       371
       -
           account_id : id;  (** The account to get changes for *)

     

       372
       372
       -
           since_state : string;  (** The previous state to compare to *)

     

       373
       373
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       374
       374
       -
         }

     

       375
       375
       -
       

     

       376
       376
       -
         (** Thread/changes response as defined in RFC8621 Section 3.2.

     

       377
       377
       -
             Reports threads that have changed since a previous state.

     

       378
       378
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>

     

       379
       379
       -
         *)

     

       380
       380
       -
         type thread_changes_response = {

     

       381
       381
       -
           account_id : id;  (** The account changes are for *)

     

       382
       382
       -
           old_state : string;  (** The state provided in the request *)

     

       383
       383
       -
           new_state : string;  (** The current state on the server *)

     

       384
       384
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       385
       385
       -
           created : id list;  (** IDs of threads created since old_state *)

     

       386
       386
       -
           updated : id list;  (** IDs of threads updated since old_state *)

     

       387
       387
       -
           destroyed : id list;  (** IDs of threads destroyed since old_state *)

     

       388
       388
       -
         }

     

       389
       389
       -
       

     

       390
       390
       -
         (** {1:email Email objects}

     

       391
       391
       -
             Email types as defined in RFC8621 Section 4

     

       392
       392
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>

     

       393
       393
       -
         *)

     

       394
       394
       -
       

     

       395
       395
       -
         (** Addressing (mailbox) information as defined in RFC8621 Section 4.1.1.

     

       396
       396
       -
             Represents an email address with optional display name.

     

       397
       397
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1>

     

       398
       398
       -
         *)

     

       399
       399
       -
         type email_address = {

     

       400
       400
       -
           name : string option;  (** Display name of the mailbox (e.g., "John Doe") *)

     

       401
       401
       -
           email : string;  (** The email address (e.g., "john@example.com") *)

     

       402
       402
       -
           parameters : (string * string) list;  (** Additional parameters for the address *)

     

       403
       403
       -
         }

     

       404
       404
       -
       

     

       405
       405
       -
         (** Message header field as defined in RFC8621 Section 4.1.2.

     

       406
       406
       -
             Represents an email header.

     

       407
       407
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.2>

     

       408
       408
       -
         *)

     

       409
       409
       -
         type header = {

     

       410
       410
       -
           name : string;  (** Name of the header field (e.g., "Subject") *)

     

       411
       411
       -
           value : string;  (** Value of the header field *)

     

       412
       412
       -
         }

     

       413
       413
       -
       

     

       414
       414
       -
         (** Email keyword (flag) as defined in RFC8621 Section 4.3.

     

       415
       415
       -
             Represents a flag or tag on an email message.

     

       416
       416
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.3>

     

       417
       417
       -
         *)

     

       418
       418
       -
         type keyword =

     

       419
       419
       -
           | Flagged    (** Message is flagged/starred *)

     

       420
       420
       -
           | Answered   (** Message has been replied to *)

     

       421
       421
       -
           | Draft      (** Message is a draft *)

     

       422
       422
       -
           | Forwarded  (** Message has been forwarded *)

     

       423
       423
       -
           | Phishing   (** Message has been reported as phishing *)

     

       424
       424
       -
           | Junk       (** Message is spam/junk *)

     

       425
       425
       -
           | NotJunk    (** Message is explicitly not spam *)

     

       426
       426
       -
           | Seen       (** Message has been read *)

     

       427
       427
       -
           | Unread     (** Message is unread (inverse of $seen) *)

     

       428
       428
       -
           | Custom of string  (** Custom/non-standard keywords *)

     

       429
       429
       -
         

     

       430
       430
       -
         (** Email message as defined in RFC8621 Section 4.

     

       431
       431
       -
             Represents an email message in a mail account.

     

       432
       432
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>

     

       433
       433
       -
         *)

     

       434
       434
       -
         type email = {

     

       435
       435
       -
           id : id;  (** Server-assigned ID for the message *)

     

       436
       436
       -
           blob_id : id;  (** ID of the raw message content blob *)

     

       437
       437
       -
           thread_id : id;  (** ID of the thread this message belongs to *)

     

       438
       438
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       439
       439
       -
           keywords : (keyword * bool) list;  (** Map of keywords to boolean (whether message has keyword) *)

     

       440
       440
       -
           size : unsigned_int;  (** Size of the message in octets *)

     

       441
       441
       -
           received_at : utc_date;  (** When the message was received by the server *)

     

       442
       442
       -
           message_id : string list;  (** Message-ID header values *)

     

       443
       443
       -
           in_reply_to : string list option;  (** In-Reply-To header values *)

     

       444
       444
       -
           references : string list option;  (** References header values *)

     

       445
       445
       -
           sender : email_address list option;  (** Sender header addresses *)

     

       446
       446
       -
           from : email_address list option;  (** From header addresses *)

     

       447
       447
       -
           to_ : email_address list option;  (** To header addresses *)

     

       448
       448
       -
           cc : email_address list option;  (** Cc header addresses *)

     

       449
       449
       -
           bcc : email_address list option;  (** Bcc header addresses *)

     

       450
       450
       -
           reply_to : email_address list option;  (** Reply-To header addresses *)

     

       451
       451
       -
           subject : string option;  (** Subject header value *)

     

       452
       452
       -
           sent_at : utc_date option;  (** Date header value as a date-time *)

     

       453
       453
       -
           has_attachment : bool option;  (** Does the message have any attachments *)

     

       454
       454
       -
           preview : string option;  (** Preview of the message (first bit of text) *)

     

       455
       455
       -
           body_values : (string * string) list option;  (** Map of part IDs to text content *)

     

       456
       456
       -
           text_body : email_body_part list option;  (** Plain text message body parts *)

     

       457
       457
       -
           html_body : email_body_part list option;  (** HTML message body parts *)

     

       458
       458
       -
           attachments : email_body_part list option;  (** Attachment parts in the message *)

     

       459
       459
       -
           headers : header list option;  (** All headers in the message *)

     

       460
       460
       -
         }

     

       461
       461
       -
       

     

       462
       462
       -
         (** Email body part as defined in RFC8621 Section 4.1.4.

     

       463
       463
       -
             Represents a MIME part in an email message.

     

       464
       464
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.4>

     

       465
       465
       -
         *)

     

       466
       466
       -
         and email_body_part = {

     

       467
       467
       -
           part_id : string option;  (** Server-assigned ID for the MIME part *)

     

       468
       468
       -
           blob_id : id option;  (** ID of the raw content for this part *)

     

       469
       469
       -
           size : unsigned_int option;  (** Size of the part in octets *)

     

       470
       470
       -
           headers : header list option;  (** Headers for this MIME part *)

     

       471
       471
       -
           name : string option;  (** Filename of this part, if any *)

     

       472
       472
       -
           type_ : string option;  (** MIME type of the part *)

     

       473
       473
       -
           charset : string option;  (** Character set of the part, if applicable *)

     

       474
       474
       -
           disposition : string option;  (** Content-Disposition value *)

     

       475
       475
       -
           cid : string option;  (** Content-ID value *)

     

       476
       476
       -
           language : string list option;  (** Content-Language values *)

     

       477
       477
       -
           location : string option;  (** Content-Location value *)

     

       478
       478
       -
           sub_parts : email_body_part list option;  (** Child MIME parts for multipart types *)

     

       479
       479
       -
           header_parameter_name : string option;  (** Header parameter name (for headers with parameters) *)

     

       480
       480
       -
           header_parameter_value : string option;  (** Header parameter value (for headers with parameters) *)

     

       481
       481
       -
         }

     

       482
       482
       -
         

     

       483
       483
       -
         (** Email query filter condition as defined in RFC8621 Section 4.4.

     

       484
       484
       -
             Specifies conditions for filtering emails in queries.

     

       485
       485
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       486
       486
       -
         *)

     

       487
       487
       -
         type email_filter_condition = {

     

       488
       488
       -
           in_mailbox : id option;  (** Only include emails in this mailbox *)

     

       489
       489
       -
           in_mailbox_other_than : id list option;  (** Only include emails not in these mailboxes *)

     

       490
       490
       -
           min_size : unsigned_int option;  (** Only include emails of at least this size in octets *)

     

       491
       491
       -
           max_size : unsigned_int option;  (** Only include emails of at most this size in octets *)

     

       492
       492
       -
           before : utc_date option;  (** Only include emails received before this date-time *)

     

       493
       493
       -
           after : utc_date option;  (** Only include emails received after this date-time *)

     

       494
       494
       -
           header : (string * string) option;  (** Only include emails with header matching value (name, value) *)

     

       495
       495
       -
           from : string option;  (** Only include emails with From containing this text *)

     

       496
       496
       -
           to_ : string option;  (** Only include emails with To containing this text *)

     

       497
       497
       -
           cc : string option;  (** Only include emails with CC containing this text *)

     

       498
       498
       -
           bcc : string option;  (** Only include emails with BCC containing this text *)

     

       499
       499
       -
           subject : string option;  (** Only include emails with Subject containing this text *)

     

       500
       500
       -
           body : string option;  (** Only include emails with body containing this text *)

     

       501
       501
       -
           has_keyword : string option;  (** Only include emails with this keyword *)

     

       502
       502
       -
           not_keyword : string option;  (** Only include emails without this keyword *)

     

       503
       503
       -
           has_attachment : bool option;  (** If true, only include emails with attachments *)

     

       504
       504
       -
           text : string option;  (** Only include emails with this text in headers or body *)

     

       505
       505
       -
         }

     

       506
       506
       -
       

     

       507
       507
       -
         (** Filter for email queries as defined in RFC8621 Section 4.4.

     

       508
       508
       -
             Complex filter for Email/query method.

     

       509
       509
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       510
       510
       -
         *)

     

       511
       511
       -
         type email_query_filter = [

     

       512
       512
       -
           | `And of email_query_filter list  (** Logical AND of filters *)

     

       513
       513
       -
           | `Or of email_query_filter list   (** Logical OR of filters *)

     

       514
       514
       -
           | `Not of email_query_filter       (** Logical NOT of a filter *)

     

       515
       515
       -
           | `Condition of email_filter_condition  (** Simple condition filter *)

     

       516
       516
       -
         ]

     

       517
       517
       -
       

     

       518
       518
       -
         (** Email/get request arguments as defined in RFC8621 Section 4.5.

     

       519
       519
       -
             Used to fetch emails by ID.

     

       520
       520
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>

     

       521
       521
       -
         *)

     

       522
       522
       -
         type email_get_arguments = {

     

       523
       523
       -
           account_id : id;  (** The account to fetch emails from *)

     

       524
       524
       -
           ids : id list option;  (** The IDs of emails to fetch, null means all *)

     

       525
       525
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       526
       526
       -
           body_properties : string list option;  (** Properties to return on body parts *)

     

       527
       527
       -
           fetch_text_body_values : bool option;  (** Whether to fetch text body content *)

     

       528
       528
       -
           fetch_html_body_values : bool option;  (** Whether to fetch HTML body content *)

     

       529
       529
       -
           fetch_all_body_values : bool option;  (** Whether to fetch all body content *)

     

       530
       530
       -
           max_body_value_bytes : unsigned_int option;  (** Maximum size of body values to return *)

     

       531
       531
       -
         }

     

       532
       532
       -
       

     

       533
       533
       -
         (** Email/get response as defined in RFC8621 Section 4.5.

     

       534
       534
       -
             Contains requested emails.

     

       535
       535
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>

     

       536
       536
       -
         *)

     

       537
       537
       -
         type email_get_response = {

     

       538
       538
       -
           account_id : id;  (** The account from which emails were fetched *)

     

       539
       539
       -
           state : string;  (** A string representing the state on the server *)

     

       540
       540
       -
           list : email list;  (** The list of emails requested *)

     

       541
       541
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       542
       542
       -
         }

     

       543
       543
       -
       

     

       544
       544
       -
         (** Email/changes request arguments as defined in RFC8621 Section 4.6.

     

       545
       545
       -
             Used to get email changes since a previous state.

     

       546
       546
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>

     

       547
       547
       -
         *)

     

       548
       548
       -
         type email_changes_arguments = {

     

       549
       549
       -
           account_id : id;  (** The account to get changes for *)

     

       550
       550
       -
           since_state : string;  (** The previous state to compare to *)

     

       551
       551
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       552
       552
       -
         }

     

       553
       553
       -
       

     

       554
       554
       -
         (** Email/changes response as defined in RFC8621 Section 4.6.

     

       555
       555
       -
             Reports emails that have changed since a previous state.

     

       556
       556
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>

     

       557
       557
       -
         *)

     

       558
       558
       -
         type email_changes_response = {

     

       559
       559
       -
           account_id : id;  (** The account changes are for *)

     

       560
       560
       -
           old_state : string;  (** The state provided in the request *)

     

       561
       561
       -
           new_state : string;  (** The current state on the server *)

     

       562
       562
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       563
       563
       -
           created : id list;  (** IDs of emails created since old_state *)

     

       564
       564
       -
           updated : id list;  (** IDs of emails updated since old_state *)

     

       565
       565
       -
           destroyed : id list;  (** IDs of emails destroyed since old_state *)

     

       566
       566
       -
         }

     

       567
       567
       -
       

     

       568
       568
       -
         (** Email/query request arguments as defined in RFC8621 Section 4.4.

     

       569
       569
       -
             Used to query emails based on filter criteria.

     

       570
       570
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       571
       571
       -
         *)

     

       572
       572
       -
         type email_query_arguments = {

     

       573
       573
       -
           account_id : id;  (** The account to query *)

     

       574
       574
       -
           filter : email_query_filter option;  (** Filter to match emails against *)

     

       575
       575
       -
           sort : comparator list option;  (** Sort criteria *)

     

       576
       576
       -
           collapse_threads : bool option;  (** Whether to collapse threads in the results *)

     

       577
       577
       -
           position : unsigned_int option;  (** Zero-based index of first result to return *)

     

       578
       578
       -
           anchor : id option;  (** ID of email to use as reference point *)

     

       579
       579
       -
           anchor_offset : int_t option;  (** Offset from anchor to start returning results *)

     

       580
       580
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       581
       581
       -
           calculate_total : bool option;  (** Whether to calculate the total number of matching emails *)

     

       582
       582
       -
         }

     

       583
       583
       -
       

     

       584
       584
       -
         (** Email/query response as defined in RFC8621 Section 4.4.

     

       585
       585
       -
             Contains IDs of emails matching the query.

     

       586
       586
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       587
       587
       -
         *)

     

       588
       588
       -
         type email_query_response = {

     

       589
       589
       -
           account_id : id;  (** The account that was queried *)

     

       590
       590
       -
           query_state : string;  (** State string for the query results *)

     

       591
       591
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       592
       592
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       593
       593
       -
           ids : id list;  (** IDs of emails matching the query *)

     

       594
       594
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       595
       595
       -
           thread_ids : id list option;  (** IDs of threads if collapse_threads was true *)

     

       596
       596
       -
         }

     

       597
       597
       -
       

     

       598
       598
       -
         (** Email/queryChanges request arguments as defined in RFC8621 Section 4.7.

     

       599
       599
       -
             Used to get changes to email query results.

     

       600
       600
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       601
       601
       -
         *)

     

       602
       602
       -
         type email_query_changes_arguments = {

     

       603
       603
       -
           account_id : id;  (** The account to query *)

     

       604
       604
       -
           filter : email_query_filter option;  (** Same filter as the original query *)

     

       605
       605
       -
           sort : comparator list option;  (** Same sort as the original query *)

     

       606
       606
       -
           collapse_threads : bool option;  (** Same collapse_threads as the original query *)

     

       607
       607
       -
           since_query_state : string;  (** The query_state from the previous result *)

     

       608
       608
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       609
       609
       -
           up_to_id : id option;  (** ID of the last email to check for changes *)

     

       610
       610
       -
         }

     

       611
       611
       -
       

     

       612
       612
       -
         (** Email/queryChanges response as defined in RFC8621 Section 4.7.

     

       613
       613
       -
             Reports changes to an email query since the previous state.

     

       614
       614
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       615
       615
       -
         *)

     

       616
       616
       -
         type email_query_changes_response = {

     

       617
       617
       -
           account_id : id;  (** The account that was queried *)

     

       618
       618
       -
           old_query_state : string;  (** The query_state from the request *)

     

       619
       619
       -
           new_query_state : string;  (** The current query_state on the server *)

     

       620
       620
       -
           total : unsigned_int option;  (** Updated total number of matches, if requested *)

     

       621
       621
       -
           removed : id list;  (** IDs that were in the old results but not the new *)

     

       622
       622
       -
           added : email_query_changes_added list;  (** IDs that are in the new results but not the old *)

     

       623
       623
       -
         }

     

       624
       624
       -
       

     

       625
       625
       -
         (** Added item in email query changes as defined in RFC8621 Section 4.7.

     

       626
       626
       -
             Represents an email added to query results.

     

       627
       627
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       628
       628
       -
         *)

     

       629
       629
       -
         and email_query_changes_added = {

     

       630
       630
       -
           id : id;  (** ID of the added email *)

     

       631
       631
       -
           index : unsigned_int;  (** Zero-based index of the added email in the results *)

     

       632
       632
       -
         }

     

       633
       633
       -
       

     

       634
       634
       -
         (** Email/set request arguments as defined in RFC8621 Section 4.8.

     

       635
       635
       -
             Used to create, update, and destroy emails.

     

       636
       636
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       637
       637
       -
         *)

     

       638
       638
       -
         type email_set_arguments = {

     

       639
       639
       -
           account_id : id;  (** The account to make changes in *)

     

       640
       640
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       641
       641
       -
           create : (id * email_creation) list option;  (** Map of creation IDs to emails to create *)

     

       642
       642
       -
           update : (id * email_update) list option;  (** Map of IDs to update properties *)

     

       643
       643
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       644
       644
       -
         }

     

       645
       645
       -
       

     

       646
       646
       -
         (** Properties for email creation as defined in RFC8621 Section 4.8.

     

       647
       647
       -
             Used to create new emails.

     

       648
       648
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       649
       649
       -
         *)

     

       650
       650
       -
         and email_creation = {

     

       651
       651
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       652
       652
       -
           keywords : (keyword * bool) list option;  (** Map of keywords to boolean (whether message has keyword) *)

     

       653
       653
       -
           received_at : utc_date option;  (** When the message was received by the server *)

     

       654
       654
       -
           message_id : string list option;  (** Message-ID header values *)

     

       655
       655
       -
           in_reply_to : string list option;  (** In-Reply-To header values *)

     

       656
       656
       -
           references : string list option;  (** References header values *)

     

       657
       657
       -
           sender : email_address list option;  (** Sender header addresses *)

     

       658
       658
       -
           from : email_address list option;  (** From header addresses *)

     

       659
       659
       -
           to_ : email_address list option;  (** To header addresses *)

     

       660
       660
       -
           cc : email_address list option;  (** Cc header addresses *)

     

       661
       661
       -
           bcc : email_address list option;  (** Bcc header addresses *)

     

       662
       662
       -
           reply_to : email_address list option;  (** Reply-To header addresses *)

     

       663
       663
       -
           subject : string option;  (** Subject header value *)

     

       664
       664
       -
           body_values : (string * string) list option;  (** Map of part IDs to text content *)

     

       665
       665
       -
           text_body : email_body_part list option;  (** Plain text message body parts *)

     

       666
       666
       -
           html_body : email_body_part list option;  (** HTML message body parts *)

     

       667
       667
       -
           attachments : email_body_part list option;  (** Attachment parts in the message *)

     

       668
       668
       -
           headers : header list option;  (** All headers in the message *)

     

       669
       669
       -
         }

     

       670
       670
       -
       

     

       671
       671
       -
         (** Properties for email update as defined in RFC8621 Section 4.8.

     

       672
       672
       -
             Used to update existing emails.

     

       673
       673
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       674
       674
       -
         *)

     

       675
       675
       -
         and email_update = {

     

       676
       676
       -
           keywords : (keyword * bool) list option;  (** New keywords to set on the email *)

     

       677
       677
       -
           mailbox_ids : (id * bool) list option;  (** New mailboxes to set for the email *)

     

       678
       678
       -
         }

     

       679
       679
       -
       

     

       680
       680
       -
         (** Email/set response as defined in RFC8621 Section 4.8.

     

       681
       681
       -
             Reports the results of email changes.

     

       682
       682
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       683
       683
       -
         *)

     

       684
       684
       -
         type email_set_response = {

     

       685
       685
       -
           account_id : id;  (** The account that was modified *)

     

       686
       686
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       687
       687
       -
           new_state : string;  (** The current state on the server *)

     

       688
       688
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       689
       689
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       690
       690
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       691
       691
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       692
       692
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       693
       693
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       694
       694
       -
         }

     

       695
       695
       -
       

     

       696
       696
       -
         (** Email/copy request arguments as defined in RFC8621 Section 4.9.

     

       697
       697
       -
             Used to copy emails between accounts.

     

       698
       698
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>

     

       699
       699
       -
         *)

     

       700
       700
       -
         type email_copy_arguments = {

     

       701
       701
       -
           from_account_id : id;  (** The account to copy emails from *)

     

       702
       702
       -
           account_id : id;  (** The account to copy emails to *)

     

       703
       703
       -
           create : (id * email_creation) list;  (** Map of creation IDs to email creation properties *)

     

       704
       704
       -
           on_success_destroy_original : bool option;  (** Whether to destroy originals after copying *)

     

       705
       705
       -
         }

     

       706
       706
       -
       

     

       707
       707
       -
         (** Email/copy response as defined in RFC8621 Section 4.9.

     

       708
       708
       -
             Reports the results of copying emails.

     

       709
       709
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>

     

       710
       710
       -
         *)

     

       711
       711
       -
         type email_copy_response = {

     

       712
       712
       -
           from_account_id : id;  (** The account emails were copied from *)

     

       713
       713
       -
           account_id : id;  (** The account emails were copied to *)

     

       714
       714
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       715
       715
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       716
       716
       -
         }

     

       717
       717
       -
       

     

       718
       718
       -
         (** Email/import request arguments as defined in RFC8621 Section 4.10.

     

       719
       719
       -
             Used to import raw emails from blobs.

     

       720
       720
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       721
       721
       -
         *)

     

       722
       722
       -
         type email_import_arguments = {

     

       723
       723
       -
           account_id : id;  (** The account to import emails into *)

     

       724
       724
       -
           emails : (id * email_import) list;  (** Map of creation IDs to import properties *)

     

       725
       725
       -
         }

     

       726
       726
       -
       

     

       727
       727
       -
         (** Properties for email import as defined in RFC8621 Section 4.10.

     

       728
       728
       -
             Used to import raw emails from blobs.

     

       729
       729
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       730
       730
       -
         *)

     

       731
       731
       -
         and email_import = {

     

       732
       732
       -
           blob_id : id;  (** ID of the blob containing the raw message *)

     

       733
       733
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       734
       734
       -
           keywords : (keyword * bool) list option;  (** Map of keywords to boolean (whether message has keyword) *)

     

       735
       735
       -
           received_at : utc_date option;  (** When the message was received, defaults to now *)

     

       736
       736
       -
         }

     

       737
       737
       -
       

     

       738
       738
       -
         (** Email/import response as defined in RFC8621 Section 4.10.

     

       739
       739
       -
             Reports the results of importing emails.

     

       740
       740
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       741
       741
       -
         *)

     

       742
       742
       -
         type email_import_response = {

     

       743
       743
       -
           account_id : id;  (** The account emails were imported into *)

     

       744
       744
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       745
       745
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed imports *)

     

       746
       746
       -
         }

     

       747
       747
       -
       

     

       748
       748
       -
         (** {1:search_snippet Search snippets}

     

       749
       749
       -
             Search snippet types as defined in RFC8621 Section 4.11

     

       750
       750
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       751
       751
       -
         *)

     

       752
       752
       -
       

     

       753
       753
       -
         (** SearchSnippet/get request arguments as defined in RFC8621 Section 4.11.

     

       754
       754
       -
             Used to get highlighted snippets from emails matching a search.

     

       755
       755
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       756
       756
       -
         *)

     

       757
       757
       -
         type search_snippet_get_arguments = {

     

       758
       758
       -
           account_id : id;  (** The account to search in *)

     

       759
       759
       -
           email_ids : id list;  (** The IDs of emails to get snippets for *)

     

       760
       760
       -
           filter : email_filter_condition;  (** Filter containing the text to find and highlight *)

     

       761
       761
       -
         }

     

       762
       762
       -
       

     

       763
       763
       -
         (** SearchSnippet/get response as defined in RFC8621 Section 4.11.

     

       764
       764
       -
             Contains search result snippets with highlighted text.

     

       765
       765
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       766
       766
       -
         *)

     

       767
       767
       -
         type search_snippet_get_response = {

     

       768
       768
       -
           account_id : id;  (** The account that was searched *)

     

       769
       769
       -
           list : (id * search_snippet) list;  (** Map of email IDs to their search snippets *)

     

       770
       770
       -
           not_found : id list;  (** IDs for which no snippet could be generated *)

     

       771
       771
       -
         }

     

       772
       772
       -
       

     

       773
       773
       -
         (** Search snippet for an email as defined in RFC8621 Section 4.11.

     

       774
       774
       -
             Contains highlighted parts of emails matching a search.

     

       775
       775
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       776
       776
       -
         *)

     

       777
       777
       -
         and search_snippet = {

     

       778
       778
       -
           subject : string option;  (** Subject with search terms highlighted *)

     

       779
       779
       -
           preview : string option;  (** Email body preview with search terms highlighted *)

     

       780
       780
       -
         }

     

       781
       781
       -
       

     

       782
       782
       -
         (** {1:submission EmailSubmission objects}

     

       783
       783
       -
             Email submission types as defined in RFC8621 Section 5

     

       784
       784
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5>

     

       785
       785
       -
         *)

     

       786
       786
       -
       

     

       787
       787
       -
         (** EmailSubmission address as defined in RFC8621 Section 5.1.

     

       788
       788
       -
             Represents an email address for mail submission.

     

       789
       789
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       790
       790
       -
         *)

     

       791
       791
       -
         type submission_address = {

     

       792
       792
       -
           email : string;  (** The email address (e.g., "john@example.com") *)

     

       793
       793
       -
           parameters : (string * string) list option;  (** SMTP extension parameters *)

     

       794
       794
       -
         }

     

       795
       795
       -
       

     

       796
       796
       -
         (** Email submission object as defined in RFC8621 Section 5.1.

     

       797
       797
       -
             Represents an email that has been or will be sent.

     

       798
       798
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       799
       799
       -
         *)

     

       800
       800
       -
         type email_submission = {

     

       801
       801
       -
           id : id;  (** Server-assigned ID for the submission *)

     

       802
       802
       -
           identity_id : id;  (** ID of the identity used to send the email *)

     

       803
       803
       -
           email_id : id;  (** ID of the email to send *)

     

       804
       804
       -
           thread_id : id;  (** ID of the thread containing the message *)

     

       805
       805
       -
           envelope : envelope option;  (** SMTP envelope for the message *)

     

       806
       806
       -
           send_at : utc_date option;  (** When to send the email, null for immediate *)

     

       807
       807
       -
           undo_status : [

     

       808
       808
       -
             | `pending  (** Submission can still be canceled *)

     

       809
       809
       -
             | `final    (** Submission can no longer be canceled *)

     

       810
       810
       -
             | `canceled (** Submission was canceled *)

     

       811
       811
       -
           ] option;  (** Current undo status of the submission *)

     

       812
       812
       -
           delivery_status : (string * submission_status) list option;  (** Map of recipient to delivery status *)

     

       813
       813
       -
           dsn_blob_ids : (string * id) list option;  (** Map of recipient to DSN blob ID *)

     

       814
       814
       -
           mdn_blob_ids : (string * id) list option;  (** Map of recipient to MDN blob ID *)

     

       815
       815
       -
         }

     

       816
       816
       -
       

     

       817
       817
       -
         (** Envelope for mail submission as defined in RFC8621 Section 5.1.

     

       818
       818
       -
             Represents the SMTP envelope for a message.

     

       819
       819
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       820
       820
       -
         *)

     

       821
       821
       -
         and envelope = {

     

       822
       822
       -
           mail_from : submission_address;  (** Return path for the message *)

     

       823
       823
       -
           rcpt_to : submission_address list;  (** Recipients for the message *)

     

       824
       824
       -
         }

     

       825
       825
       -
       

     

       826
       826
       -
         (** Delivery status for submitted email as defined in RFC8621 Section 5.1.

     

       827
       827
       -
             Represents the SMTP status of a delivery attempt.

     

       828
       828
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       829
       829
       -
         *)

     

       830
       830
       -
         and submission_status = {

     

       831
       831
       -
           smtp_reply : string;  (** SMTP response from the server *)

     

       832
       832
       -
           delivered : string option;  (** Timestamp when message was delivered, if successful *)

     

       833
       833
       -
         }

     

       834
       834
       -
       

     

       835
       835
       -
         (** EmailSubmission/get request arguments as defined in RFC8621 Section 5.3.

     

       836
       836
       -
             Used to fetch email submissions by ID.

     

       837
       837
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>

     

       838
       838
       -
         *)

     

       839
       839
       -
         type email_submission_get_arguments = {

     

       840
       840
       -
           account_id : id;  (** The account to fetch submissions from *)

     

       841
       841
       -
           ids : id list option;  (** The IDs of submissions to fetch, null means all *)

     

       842
       842
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       843
       843
       -
         }

     

       844
       844
       -
       

     

       845
       845
       -
         (** EmailSubmission/get response as defined in RFC8621 Section 5.3.

     

       846
       846
       -
             Contains requested email submissions.

     

       847
       847
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>

     

       848
       848
       -
         *)

     

       849
       849
       -
         type email_submission_get_response = {

     

       850
       850
       -
           account_id : id;  (** The account from which submissions were fetched *)

     

       851
       851
       -
           state : string;  (** A string representing the state on the server *)

     

       852
       852
       -
           list : email_submission list;  (** The list of submissions requested *)

     

       853
       853
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       854
       854
       -
         }

     

       855
       855
       -
       

     

       856
       856
       -
         (** EmailSubmission/changes request arguments as defined in RFC8621 Section 5.4.

     

       857
       857
       -
             Used to get submission changes since a previous state.

     

       858
       858
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>

     

       859
       859
       -
         *)

     

       860
       860
       -
         type email_submission_changes_arguments = {

     

       861
       861
       -
           account_id : id;  (** The account to get changes for *)

     

       862
       862
       -
           since_state : string;  (** The previous state to compare to *)

     

       863
       863
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       864
       864
       -
         }

     

       865
       865
       -
       

     

       866
       866
       -
         (** EmailSubmission/changes response as defined in RFC8621 Section 5.4.

     

       867
       867
       -
             Reports submissions that have changed since a previous state.

     

       868
       868
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>

     

       869
       869
       -
         *)

     

       870
       870
       -
         type email_submission_changes_response = {

     

       871
       871
       -
           account_id : id;  (** The account changes are for *)

     

       872
       872
       -
           old_state : string;  (** The state provided in the request *)

     

       873
       873
       -
           new_state : string;  (** The current state on the server *)

     

       874
       874
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       875
       875
       -
           created : id list;  (** IDs of submissions created since old_state *)

     

       876
       876
       -
           updated : id list;  (** IDs of submissions updated since old_state *)

     

       877
       877
       -
           destroyed : id list;  (** IDs of submissions destroyed since old_state *)

     

       878
       878
       -
         }

     

       879
       879
       -
       

     

       880
       880
       -
         (** EmailSubmission/query filter condition as defined in RFC8621 Section 5.5.

     

       881
       881
       -
             Specifies conditions for filtering email submissions in queries.

     

       882
       882
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       883
       883
       -
         *)

     

       884
       884
       -
         type email_submission_filter_condition = {

     

       885
       885
       -
           identity_id : id option;  (** Only include submissions with this identity *)

     

       886
       886
       -
           email_id : id option;  (** Only include submissions for this email *)

     

       887
       887
       -
           thread_id : id option;  (** Only include submissions for emails in this thread *)

     

       888
       888
       -
           before : utc_date option;  (** Only include submissions created before this date-time *)

     

       889
       889
       -
           after : utc_date option;  (** Only include submissions created after this date-time *)

     

       890
       890
       -
           subject : string option;  (** Only include submissions with matching subjects *)

     

       891
       891
       -
         }

     

       892
       892
       -
       

     

       893
       893
       -
         (** Filter for email submission queries as defined in RFC8621 Section 5.5.

     

       894
       894
       -
             Complex filter for EmailSubmission/query method.

     

       895
       895
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       896
       896
       -
         *)

     

       897
       897
       -
         type email_submission_query_filter = [

     

       898
       898
       -
           | `And of email_submission_query_filter list  (** Logical AND of filters *)

     

       899
       899
       -
           | `Or of email_submission_query_filter list   (** Logical OR of filters *)

     

       900
       900
       -
           | `Not of email_submission_query_filter       (** Logical NOT of a filter *)

     

       901
       901
       -
           | `Condition of email_submission_filter_condition  (** Simple condition filter *)

     

       902
       902
       -
         ]

     

       903
       903
       -
       

     

       904
       904
       -
         (** EmailSubmission/query request arguments as defined in RFC8621 Section 5.5.

     

       905
       905
       -
             Used to query email submissions based on filter criteria.

     

       906
       906
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       907
       907
       -
         *)

     

       908
       908
       -
         type email_submission_query_arguments = {

     

       909
       909
       -
           account_id : id;  (** The account to query *)

     

       910
       910
       -
           filter : email_submission_query_filter option;  (** Filter to match submissions against *)

     

       911
       911
       -
           sort : comparator list option;  (** Sort criteria *)

     

       912
       912
       -
           position : unsigned_int option;  (** Zero-based index of first result to return *)

     

       913
       913
       -
           anchor : id option;  (** ID of submission to use as reference point *)

     

       914
       914
       -
           anchor_offset : int_t option;  (** Offset from anchor to start returning results *)

     

       915
       915
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       916
       916
       -
           calculate_total : bool option;  (** Whether to calculate the total number of matching submissions *)

     

       917
       917
       -
         }

     

       918
       918
       -
       

     

       919
       919
       -
         (** EmailSubmission/query response as defined in RFC8621 Section 5.5.

     

       920
       920
       -
             Contains IDs of email submissions matching the query.

     

       921
       921
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       922
       922
       -
         *)

     

       923
       923
       -
         type email_submission_query_response = {

     

       924
       924
       -
           account_id : id;  (** The account that was queried *)

     

       925
       925
       -
           query_state : string;  (** State string for the query results *)

     

       926
       926
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       927
       927
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       928
       928
       -
           ids : id list;  (** IDs of email submissions matching the query *)

     

       929
       929
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       930
       930
       -
         }

     

       931
       931
       -
       

     

       932
       932
       -
         (** EmailSubmission/set request arguments as defined in RFC8621 Section 5.6.

     

       933
       933
       -
             Used to create, update, and destroy email submissions.

     

       934
       934
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       935
       935
       -
         *)

     

       936
       936
       -
         type email_submission_set_arguments = {

     

       937
       937
       -
           account_id : id;  (** The account to make changes in *)

     

       938
       938
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       939
       939
       -
           create : (id * email_submission_creation) list option;  (** Map of creation IDs to submissions to create *)

     

       940
       940
       -
           update : (id * email_submission_update) list option;  (** Map of IDs to update properties *)

     

       941
       941
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       942
       942
       -
           on_success_update_email : (id * email_update) list option;  (** Emails to update if submissions succeed *)

     

       943
       943
       -
         }

     

       944
       944
       -
       

     

       945
       945
       -
         (** Properties for email submission creation as defined in RFC8621 Section 5.6.

     

       946
       946
       -
             Used to create new email submissions.

     

       947
       947
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       948
       948
       -
         *)

     

       949
       949
       -
         and email_submission_creation = {

     

       950
       950
       -
           email_id : id;  (** ID of the email to send *)

     

       951
       951
       -
           identity_id : id;  (** ID of the identity to send from *)

     

       952
       952
       -
           envelope : envelope option;  (** Custom envelope, if needed *)

     

       953
       953
       -
           send_at : utc_date option;  (** When to send the email, defaults to now *)

     

       954
       954
       -
         }

     

       955
       955
       -
       

     

       956
       956
       -
         (** Properties for email submission update as defined in RFC8621 Section 5.6.

     

       957
       957
       -
             Used to update existing email submissions.

     

       958
       958
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       959
       959
       -
         *)

     

       960
       960
       -
         and email_submission_update = {

     

       961
       961
       -
           email_id : id option;  (** New email ID to use for this submission *)

     

       962
       962
       -
           identity_id : id option;  (** New identity ID to use for this submission *)

     

       963
       963
       -
           envelope : envelope option;  (** New envelope to use for this submission *)

     

       964
       964
       -
           undo_status : [`canceled] option;  (** Set to cancel a pending submission *)

     

       965
       965
       -
         }

     

       966
       966
       -
       

     

       967
       967
       -
         (** EmailSubmission/set response as defined in RFC8621 Section 5.6.

     

       968
       968
       -
             Reports the results of email submission changes.

     

       969
       969
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       970
       970
       -
         *)

     

       971
       971
       -
         type email_submission_set_response = {

     

       972
       972
       -
           account_id : id;  (** The account that was modified *)

     

       973
       973
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       974
       974
       -
           new_state : string;  (** The current state on the server *)

     

       975
       975
       -
           created : (id * email_submission) list option;  (** Map of creation IDs to created submissions *)

     

       976
       976
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       977
       977
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       978
       978
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       979
       979
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       980
       980
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       981
       981
       -
         }

     

       982
       982
       -
       

     

       983
       983
       -
         (** {1:identity Identity objects}

     

       984
       984
       -
             Identity types as defined in RFC8621 Section 6

     

       985
       985
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>

     

       986
       986
       -
         *)

     

       987
       987
       -
       

     

       988
       988
       -
         (** Identity for sending mail as defined in RFC8621 Section 6.

     

       989
       989
       -
             Represents an email identity that can be used to send messages.

     

       990
       990
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>

     

       991
       991
       -
         *)

     

       992
       992
       -
         type identity = {

     

       993
       993
       -
           id : id;  (** Server-assigned ID for the identity *)

     

       994
       994
       -
           name : string;  (** Display name for the identity *)

     

       995
       995
       -
           email : string;  (** Email address for the identity *)

     

       996
       996
       -
           reply_to : email_address list option;  (** Reply-To addresses to use when sending *)

     

       997
       997
       -
           bcc : email_address list option;  (** BCC addresses to automatically include *)

     

       998
       998
       -
           text_signature : string option;  (** Plain text signature for the identity *)

     

       999
       999
       -
           html_signature : string option;  (** HTML signature for the identity *)

     

       1000
       1000
       -
           may_delete : bool;  (** Whether this identity can be deleted *)

     

       1001
       1001
       -
         }

     

       1002
       1002
       -
       

     

       1003
       1003
       -
         (** Identity/get request arguments as defined in RFC8621 Section 6.1.

     

       1004
       1004
       -
             Used to fetch identities by ID.

     

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

     

       1006
       1006
       -
         *)

     

       1007
       1007
       -
         type identity_get_arguments = {

     

       1008
       1008
       -
           account_id : id;  (** The account to fetch identities from *)

     

       1009
       1009
       -
           ids : id list option;  (** The IDs of identities to fetch, null means all *)

     

       1010
       1010
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       1011
       1011
       -
         }

     

       1012
       1012
       -
       

     

       1013
       1013
       -
         (** Identity/get response as defined in RFC8621 Section 6.1.

     

       1014
       1014
       -
             Contains requested identities.

     

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

     

       1016
       1016
       -
         *)

     

       1017
       1017
       -
         type identity_get_response = {

     

       1018
       1018
       -
           account_id : id;  (** The account from which identities were fetched *)

     

       1019
       1019
       -
           state : string;  (** A string representing the state on the server *)

     

       1020
       1020
       -
           list : identity list;  (** The list of identities requested *)

     

       1021
       1021
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       1022
       1022
       -
         }

     

       1023
       1023
       -
       

     

       1024
       1024
       -
         (** Identity/changes request arguments as defined in RFC8621 Section 6.2.

     

       1025
       1025
       -
             Used to get identity changes since a previous state.

     

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

     

       1027
       1027
       -
         *)

     

       1028
       1028
       -
         type identity_changes_arguments = {

     

       1029
       1029
       -
           account_id : id;  (** The account to get changes for *)

     

       1030
       1030
       -
           since_state : string;  (** The previous state to compare to *)

     

       1031
       1031
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       1032
       1032
       -
         }

     

       1033
       1033
       -
       

     

       1034
       1034
       -
         (** Identity/changes response as defined in RFC8621 Section 6.2.

     

       1035
       1035
       -
             Reports identities that have changed since a previous state.

     

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

     

       1037
       1037
       -
         *)

     

       1038
       1038
       -
         type identity_changes_response = {

     

       1039
       1039
       -
           account_id : id;  (** The account changes are for *)

     

       1040
       1040
       -
           old_state : string;  (** The state provided in the request *)

     

       1041
       1041
       -
           new_state : string;  (** The current state on the server *)

     

       1042
       1042
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       1043
       1043
       -
           created : id list;  (** IDs of identities created since old_state *)

     

       1044
       1044
       -
           updated : id list;  (** IDs of identities updated since old_state *)

     

       1045
       1045
       -
           destroyed : id list;  (** IDs of identities destroyed since old_state *)

     

       1046
       1046
       -
         }

     

       1047
       1047
       -
       

     

       1048
       1048
       -
         (** Identity/set request arguments as defined in RFC8621 Section 6.3.

     

       1049
       1049
       -
             Used to create, update, and destroy identities.

     

       1050
       1050
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1051
       1051
       -
         *)

     

       1052
       1052
       -
         type identity_set_arguments = {

     

       1053
       1053
       -
           account_id : id;  (** The account to make changes in *)

     

       1054
       1054
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       1055
       1055
       -
           create : (id * identity_creation) list option;  (** Map of creation IDs to identities to create *)

     

       1056
       1056
       -
           update : (id * identity_update) list option;  (** Map of IDs to update properties *)

     

       1057
       1057
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       1058
       1058
       -
         }

     

       1059
       1059
       -
       

     

       1060
       1060
       -
         (** Properties for identity creation as defined in RFC8621 Section 6.3.

     

       1061
       1061
       -
             Used to create new identities.

     

       1062
       1062
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1063
       1063
       -
         *)

     

       1064
       1064
       -
         and identity_creation = {

     

       1065
       1065
       -
           name : string;  (** Display name for the identity *)

     

       1066
       1066
       -
           email : string;  (** Email address for the identity *)

     

       1067
       1067
       -
           reply_to : email_address list option;  (** Reply-To addresses to use when sending *)

     

       1068
       1068
       -
           bcc : email_address list option;  (** BCC addresses to automatically include *)

     

       1069
       1069
       -
           text_signature : string option;  (** Plain text signature for the identity *)

     

       1070
       1070
       -
           html_signature : string option;  (** HTML signature for the identity *)

     

       1071
       1071
       -
         }

     

       1072
       1072
       -
       

     

       1073
       1073
       -
         (** Properties for identity update as defined in RFC8621 Section 6.3.

     

       1074
       1074
       -
             Used to update existing identities.

     

       1075
       1075
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1076
       1076
       -
         *)

     

       1077
       1077
       -
         and identity_update = {

     

       1078
       1078
       -
           name : string option;  (** New display name for the identity *)

     

       1079
       1079
       -
           email : string option;  (** New email address for the identity *)

     

       1080
       1080
       -
           reply_to : email_address list option;  (** New Reply-To addresses to use *)

     

       1081
       1081
       -
           bcc : email_address list option;  (** New BCC addresses to automatically include *)

     

       1082
       1082
       -
           text_signature : string option;  (** New plain text signature *)

     

       1083
       1083
       -
           html_signature : string option;  (** New HTML signature *)

     

       1084
       1084
       -
         }

     

       1085
       1085
       -
       

     

       1086
       1086
       -
         (** Identity/set response as defined in RFC8621 Section 6.3.

     

       1087
       1087
       -
             Reports the results of identity changes.

     

       1088
       1088
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1089
       1089
       -
         *)

     

       1090
       1090
       -
         type identity_set_response = {

     

       1091
       1091
       -
           account_id : id;  (** The account that was modified *)

     

       1092
       1092
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       1093
       1093
       -
           new_state : string;  (** The current state on the server *)

     

       1094
       1094
       -
           created : (id * identity) list option;  (** Map of creation IDs to created identities *)

     

       1095
       1095
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       1096
       1096
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       1097
       1097
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       1098
       1098
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       1099
       1099
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       1100
       1100
       -
         }

     

       1101
       1101
       -
       

     

       1102
       1102
       -
         (** {1:vacation_response VacationResponse objects}

     

       1103
       1103
       -
             Vacation response types as defined in RFC8621 Section 7

     

       1104
       1104
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7>

     

       1105
       1105
       -
         *)

     

       1106
       1106
       -
       

     

       1107
       1107
       -
         (** Vacation auto-reply setting as defined in RFC8621 Section 7.

     

       1108
       1108
       -
             Represents an automatic vacation/out-of-office response.

     

       1109
       1109
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7>

     

       1110
       1110
       -
         *)

     

       1111
       1111
       -
         type vacation_response = {

     

       1112
       1112
       -
           id : id;  (** Server-assigned ID for the vacation response *)

     

       1113
       1113
       -
           is_enabled : bool;  (** Whether the vacation response is active *)

     

       1114
       1114
       -
           from_date : utc_date option;  (** Start date-time of the vacation period *)

     

       1115
       1115
       -
           to_date : utc_date option;  (** End date-time of the vacation period *)

     

       1116
       1116
       -
           subject : string option;  (** Subject line for the vacation response *)

     

       1117
       1117
       -
           text_body : string option;  (** Plain text body for the vacation response *)

     

       1118
       1118
       -
           html_body : string option;  (** HTML body for the vacation response *)

     

       1119
       1119
       -
         }

     

       1120
       1120
       -
       

     

       1121
       1121
       -
         (** VacationResponse/get request arguments as defined in RFC8621 Section 7.2.

     

       1122
       1122
       -
             Used to fetch vacation responses by ID.

     

       1123
       1123
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>

     

       1124
       1124
       -
         *)

     

       1125
       1125
       -
         type vacation_response_get_arguments = {

     

       1126
       1126
       -
           account_id : id;  (** The account to fetch vacation responses from *)

     

       1127
       1127
       -
           ids : id list option;  (** The IDs of vacation responses to fetch, null means all *)

     

       1128
       1128
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       1129
       1129
       -
         }

     

       1130
       1130
       -
       

     

       1131
       1131
       -
         (** VacationResponse/get response as defined in RFC8621 Section 7.2.

     

       1132
       1132
       -
             Contains requested vacation responses.

     

       1133
       1133
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>

     

       1134
       1134
       -
         *)

     

       1135
       1135
       -
         type vacation_response_get_response = {

     

       1136
       1136
       -
           account_id : id;  (** The account from which vacation responses were fetched *)

     

       1137
       1137
       -
           state : string;  (** A string representing the state on the server *)

     

       1138
       1138
       -
           list : vacation_response list;  (** The list of vacation responses requested *)

     

       1139
       1139
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       1140
       1140
       -
         }

     

       1141
       1141
       -
       

     

       1142
       1142
       -
         (** VacationResponse/set request arguments as defined in RFC8621 Section 7.3.

     

       1143
       1143
       -
             Used to update vacation responses.

     

       1144
       1144
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1145
       1145
       -
         *)

     

       1146
       1146
       -
         type vacation_response_set_arguments = {

     

       1147
       1147
       -
           account_id : id;  (** The account to make changes in *)

     

       1148
       1148
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       1149
       1149
       -
           update : (id * vacation_response_update) list;  (** Map of IDs to update properties *)

     

       1150
       1150
       -
         }

     

       1151
       1151
       -
       

     

       1152
       1152
       -
         (** Properties for vacation response update as defined in RFC8621 Section 7.3.

     

       1153
       1153
       -
             Used to update existing vacation responses.

     

       1154
       1154
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1155
       1155
       -
         *)

     

       1156
       1156
       -
         and vacation_response_update = {

     

       1157
       1157
       -
           is_enabled : bool option;  (** Whether the vacation response is active *)

     

       1158
       1158
       -
           from_date : utc_date option;  (** Start date-time of the vacation period *)

     

       1159
       1159
       -
           to_date : utc_date option;  (** End date-time of the vacation period *)

     

       1160
       1160
       -
           subject : string option;  (** Subject line for the vacation response *)

     

       1161
       1161
       -
           text_body : string option;  (** Plain text body for the vacation response *)

     

       1162
       1162
       -
           html_body : string option;  (** HTML body for the vacation response *)

     

       1163
       1163
       -
         }

     

       1164
       1164
       -
       

     

       1165
       1165
       -
         (** VacationResponse/set response as defined in RFC8621 Section 7.3.

     

       1166
       1166
       -
             Reports the results of vacation response changes.

     

       1167
       1167
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1168
       1168
       -
         *)

     

       1169
       1169
       -
         type vacation_response_set_response = {

     

       1170
       1170
       -
           account_id : id;  (** The account that was modified *)

     

       1171
       1171
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       1172
       1172
       -
           new_state : string;  (** The current state on the server *)

     

       1173
       1173
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       1174
       1174
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       1175
       1175
       -
         }

     

       1176
       1176
       -
         

     

       1177
       1177
       -
         (** {1:message_flags Message Flags and Mailbox Attributes}

     

       1178
       1178
       -
             Message flag types as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02

     

       1179
       1179
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute>

     

       1180
       1180
       -
         *)

     

       1181
       1181
       -
         

     

       1182
       1182
       -
         (** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords

     

       1183
       1183
       -
             as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 3.

     

       1184
       1184
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3>

     

       1185
       1185
       -
         *)

     

       1186
       1186
       -
         type flag_color =

     

       1187
       1187
       -
           | Red     (** Bit pattern 000 - default color *)

     

       1188
       1188
       -
           | Orange  (** Bit pattern 100 - MailFlagBit2 set *)

     

       1189
       1189
       -
           | Yellow  (** Bit pattern 010 - MailFlagBit1 set *)

     

       1190
       1190
       -
           | Green   (** Bit pattern 111 - all bits set *)

     

       1191
       1191
       -
           | Blue    (** Bit pattern 001 - MailFlagBit0 set *)

     

       1192
       1192
       -
           | Purple  (** Bit pattern 101 - MailFlagBit2 and MailFlagBit0 set *)

     

       1193
       1193
       -
           | Gray    (** Bit pattern 011 - MailFlagBit1 and MailFlagBit0 set *)

     

       1194
       1194
       -
         

     

       1195
       1195
       -
         (** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.1.

     

       1196
       1196
       -
             These are standardized keywords that can be applied to email messages.

     

       1197
       1197
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.1>

     

       1198
       1198
       -
         *)

     

       1199
       1199
       -
         type message_keyword =

     

       1200
       1200
       -
           | Notify         (** Indicate a notification should be shown for this message *)

     

       1201
       1201
       -
           | Muted          (** User is not interested in future replies to this thread *)

     

       1202
       1202
       -
           | Followed       (** User is particularly interested in future replies to this thread *)

     

       1203
       1203
       -
           | Memo           (** Message is a note-to-self about another message in the same thread *)

     

       1204
       1204
       -
           | HasMemo        (** Message has an associated memo with the $memo keyword *)

     

       1205
       1205
       -
           | HasAttachment  (** Message has an attachment *)

     

       1206
       1206
       -
           | HasNoAttachment (** Message does not have an attachment *)

     

       1207
       1207
       -
           | AutoSent       (** Message was sent automatically as a response due to a user rule *)

     

       1208
       1208
       -
           | Unsubscribed   (** User has unsubscribed from the thread this message is in *)

     

       1209
       1209
       -
           | CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)

     

       1210
       1210
       -
           | Imported       (** Message was imported from another mailbox *)

     

       1211
       1211
       -
           | IsTrusted      (** Server has verified authenticity of the from name and email *)

     

       1212
       1212
       -
           | MaskedEmail    (** Message was received via an alias created for an individual sender *)

     

       1213
       1213
       -
           | New            (** Message should be made more prominent due to a recent action *)

     

       1214
       1214
       -
           | MailFlagBit0   (** Bit 0 of the 3-bit flag color pattern *)

     

       1215
       1215
       -
           | MailFlagBit1   (** Bit 1 of the 3-bit flag color pattern *)

     

       1216
       1216
       -
           | MailFlagBit2   (** Bit 2 of the 3-bit flag color pattern *)

     

       1217
       1217
       -
           | OtherKeyword of string (** Other non-standard keywords *)

     

       1218
       1218
       -
         

     

       1219
       1219
       -
         (** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.2.

     

       1220
       1220
       -
             These are standardized attributes for special-purpose mailboxes.

     

       1221
       1221
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.2>

     

       1222
       1222
       -
         *)

     

       1223
       1223
       -
         type mailbox_attribute =

     

       1224
       1224
       -
           | Snoozed    (** Mailbox containing messages that have been snoozed *)

     

       1225
       1225
       -
           | Scheduled  (** Mailbox containing messages scheduled to be sent later *)

     

       1226
       1226
       -
           | Memos      (** Mailbox containing messages with the $memo keyword *)

     

       1227
       1227
       -
           | OtherAttribute of string (** Other non-standard mailbox attributes *)

     

       1228
       1228
       -
         

     

       1229
       1229
       -
         (** Convert bit values to a flag color

     

       1230
       1230
       -
             @param bit0 Value of bit 0 (least significant bit)

     

       1231
       1231
       -
             @param bit1 Value of bit 1

     

       1232
       1232
       -
             @param bit2 Value of bit 2 (most significant bit)

     

       1233
       1233
       -
             @return The corresponding flag color

     

       1234
       1234
       -
         *)

     

       1235
       1235
       -
         val flag_color_of_bits : bool -> bool -> bool -> flag_color

     

       1236
       1236
       -
         

     

       1237
       1237
       -
         (** Get the bit values for a flag color

     

       1238
       1238
       -
             @param color The flag color

     

       1239
       1239
       -
             @return Tuple of (bit2, bit1, bit0) values

     

       1240
       1240
       -
         *)

     

       1241
       1241
       -
         val bits_of_flag_color : flag_color -> bool * bool * bool

     

       1242
       1242
       -
         

     

       1243
       1243
       -
         (** Check if a message has a flag color based on its keywords

     

       1244
       1244
       -
             @param keywords The list of keywords for the message

     

       1245
       1245
       -
             @return True if the message has one or more flag color bits set

     

       1246
       1246
       -
         *)

     

       1247
       1247
       -
         val has_flag_color : (keyword * bool) list -> bool

     

       1248
       1248
       -
         

     

       1249
       1249
       -
         (** Get the flag color from a message's keywords, if present

     

       1250
       1250
       -
             @param keywords The list of keywords for the message

     

       1251
       1251
       -
             @return The flag color if all required bits are present, None otherwise

     

       1252
       1252
       -
         *)

     

       1253
       1253
       -
         val get_flag_color : (keyword * bool) list -> flag_color option

     

       1254
       1254
       -
         

     

       1255
       1255
       -
         (** Convert a message keyword to its string representation

     

       1256
       1256
       -
             @param keyword The message keyword

     

       1257
       1257
       -
             @return String representation with $ prefix (e.g., "$notify")

     

       1258
       1258
       -
         *)

     

       1259
       1259
       -
         val string_of_message_keyword : message_keyword -> string

     

       1260
       1260
       -
         

     

       1261
       1261
       -
         (** Parse a string into a message keyword

     

       1262
       1262
       -
             @param s The string to parse (with or without $ prefix)

     

       1263
       1263
       -
             @return The corresponding message keyword

     

       1264
       1264
       -
         *)

     

       1265
       1265
       -
         val message_keyword_of_string : string -> message_keyword

     

       1266
       1266
       -
         

     

       1267
       1267
       -
         (** Convert a mailbox attribute to its string representation

     

       1268
       1268
       -
             @param attr The mailbox attribute

     

       1269
       1269
       -
             @return String representation with $ prefix (e.g., "$snoozed")

     

       1270
       1270
       -
         *)

     

       1271
       1271
       -
         val string_of_mailbox_attribute : mailbox_attribute -> string

     

       1272
       1272
       -
         

     

       1273
       1273
       -
         (** Parse a string into a mailbox attribute

     

       1274
       1274
       -
             @param s The string to parse (with or without $ prefix)

     

       1275
       1275
       -
             @return The corresponding mailbox attribute

     

       1276
       1276
       -
         *)

     

       1277
       1277
       -
         val mailbox_attribute_of_string : string -> mailbox_attribute

     

       1278
       1278
       -
         

     

       1279
       1279
       -
         (** Get a human-readable representation of a flag color

     

       1280
       1280
       -
             @param color The flag color

     

       1281
       1281
       -
             @return Human-readable name of the color

     

       1282
       1282
       -
         *)

     

       1283
       1283
       -
         val human_readable_flag_color : flag_color -> string

     

       1284
       1284
       -
         

     

       1285
       1285
       -
         (** Get a human-readable representation of a message keyword

     

       1286
       1286
       -
             @param keyword The message keyword

     

       1287
       1287
       -
             @return Human-readable description of the keyword

     

       1288
       1288
       -
         *)

     

       1289
       1289
       -
         val human_readable_message_keyword : message_keyword -> string

     

       1290
       1290
       -
         

     

       1291
       1291
       -
         (** Format email keywords into a human-readable string representation

     

       1292
       1292
       -
             @param keywords The list of keywords and their values

     

       1293
       1293
       -
             @return Human-readable comma-separated list of keywords

     

       1294
       1294
       -
         *)

     

       1295
       1295
       -
         val format_email_keywords : (keyword * bool) list -> string

     

       1296
       1296
       -
       end

     

       1297
       1297
       -
       

     

       1298
       1298
       -
       (** {1 JSON serialization}

     

       1299
       1299
       -
           Functions for serializing and deserializing JMAP Mail objects to/from JSON

     

       1300
       1300
       -
       *)

     

       1301
       1301
       -
       

     

       1302
       1302
       -
       module Json : sig

     

       1303
       1303
       -
         open Types

     

       1304
       1304
       -
       

     

       1305
       1305
       -
         (** {2 Helper functions for serialization}

     

       1306
       1306
       -
             Utility functions for converting between OCaml types and JSON representation

     

       1307
       1307
       -
         *)

     

       1308
       1308
       -
         

     

       1309
       1309
       -
         (** Convert a mailbox role to its string representation

     

       1310
       1310
       -
             @param role The mailbox role

     

       1311
       1311
       -
             @return String representation (e.g., "inbox", "drafts", etc.)

     

       1312
       1312
       -
         *)

     

       1313
       1313
       -
         val string_of_mailbox_role : mailbox_role -> string

     

       1314
       1314
       -
         

     

       1315
       1315
       -
         (** Parse a string into a mailbox role

     

       1316
       1316
       -
             @param s The string to parse

     

       1317
       1317
       -
             @return The corresponding mailbox role, or Unknown if not recognized

     

       1318
       1318
       -
         *)

     

       1319
       1319
       -
         val mailbox_role_of_string : string -> mailbox_role

     

       1320
       1320
       -
         

     

       1321
       1321
       -
         (** Convert an email keyword to its string representation

     

       1322
       1322
       -
             @param keyword The email keyword

     

       1323
       1323
       -
             @return String representation with $ prefix (e.g., "$flagged")

     

       1324
       1324
       -
         *)

     

       1325
       1325
       -
         val string_of_keyword : keyword -> string

     

       1326
       1326
       -
         

     

       1327
       1327
       -
         (** Parse a string into an email keyword

     

       1328
       1328
       -
             @param s The string to parse (with or without $ prefix)

     

       1329
       1329
       -
             @return The corresponding email keyword

     

       1330
       1330
       -
         *)

     

       1331
       1331
       -
         val keyword_of_string : string -> keyword

     

       1332
       1332
       -
       

     

       1333
       1333
       -
         (** {2 Mailbox serialization}

     

       1334
       1334
       -
             Functions for serializing and deserializing mailbox objects

     

       1335
       1335
       -
         *)

     

       1336
       1336
       -
       

     

       1337
       1337
       -
         (** TODO:claude - Need to implement all JSON serialization functions 

     

       1338
       1338
       -
             for each type we've defined. This would be a substantial amount of

     

       1339
       1339
       -
             code and likely require additional understanding of the ezjsonm API.

     

       1340
       1340
       -
             

     

       1341
       1341
       -
             The interface would include functions like:

     

       1342
       1342
       -
             

     

       1343
       1343
       -
             val mailbox_to_json : mailbox -> Ezjsonm.value

     

       1344
       1344
       -
             val mailbox_of_json : Ezjsonm.value -> mailbox result

     

       1345
       1345
       -
             

     

       1346
       1346
       -
             And similarly for all other types.

     

       1347
       1347
       -
         *)

     

       1348
       1348
       -
       end

     

       1349
       1349
       -
       

     

       1350
       1350
       -
       (** {1 API functions}

     

       1351
       1351
       -
           High-level functions for interacting with JMAP Mail servers

     

       1352
       1352
       -
       *)

     

       1353
       1353
       -
       

     

       1354
       1354
       -
       (** Authentication credentials for a JMAP server *)

     

       1355
       1355
       -
       type credentials = {

     

       1356
       1356
       -
         username: string;  (** Username for authentication *)

     

       1357
       1357
       -
         password: string;  (** Password for authentication *)

     

       1358
       1358
       -
       }

     

       1359
       1359
       -
       

     

       1360
       1360
       -
       (** Connection to a JMAP mail server *)

     

       1361
       1361
       -
       type connection = {

     

       1362
       1362
       -
         session: Jmap.Types.session;  (** Session information from the server *)

     

       1363
       1363
       -
         config: Jmap.Api.config;      (** Configuration for API requests *)

     

       1364
       1364
       -
       }

     

       1365
       1365
       -
       

     

       1366
       1366
       -
       (** Login to a JMAP server and establish a connection

     

       1367
       1367
       -
           @param uri The URI of the JMAP server

     

       1368
       1368
       -
           @param credentials Authentication credentials

     

       1369
       1369
       -
           @return A connection object if successful

     

       1370
       1370
       -
           

     

       1371
       1371
       -
           Creates a new connection to a JMAP server using username/password authentication.

     

       1372
       1372
       -
       *)

     

       1373
       1373
       -
       val login : 

     

       1374
       1374
       -
         uri:string -> 

     

       1375
       1375
       -
         credentials:credentials -> 

     

       1376
       1376
       -
         (connection, Jmap.Api.error) result Lwt.t

     

       1377
       1377
       -
       

     

       1378
       1378
       -
       (** Login to a JMAP server using an API token

     

       1379
       1379
       -
           @param uri The URI of the JMAP server

     

       1380
       1380
       -
           @param api_token The API token for authentication

     

       1381
       1381
       -
           @return A connection object if successful

     

       1382
       1382
       -
           

     

       1383
       1383
       -
           Creates a new connection to a JMAP server using Bearer token authentication.

     

       1384
       1384
       -
       *)

     

       1385
       1385
       -
       val login_with_token : 

     

       1386
       1386
       -
         uri:string -> 

     

       1387
       1387
       -
         api_token:string -> 

     

       1388
       1388
       -
         (connection, Jmap.Api.error) result Lwt.t

     

       1389
       1389
       -
       

     

       1390
       1390
       -
       (** Get all mailboxes for an account

     

       1391
       1391
       -
           @param conn The JMAP connection

     

       1392
       1392
       -
           @param account_id The account ID to get mailboxes for

     

       1393
       1393
       -
           @return A list of mailboxes if successful

     

       1394
       1394
       -
           

     

       1395
       1395
       -
           Retrieves all mailboxes (folders) in the specified account.

     

       1396
       1396
       -
       *)

     

       1397
       1397
       -
       val get_mailboxes : 

     

       1398
       1398
       -
         connection -> 

     

       1399
       1399
       -
         account_id:Jmap.Types.id -> 

     

       1400
       1400
       -
         (Types.mailbox list, Jmap.Api.error) result Lwt.t

     

       1401
       1401
       -
       

     

       1402
       1402
       -
       (** Get a specific mailbox by ID

     

       1403
       1403
       -
           @param conn The JMAP connection

     

       1404
       1404
       -
           @param account_id The account ID

     

       1405
       1405
       -
           @param mailbox_id The mailbox ID to retrieve

     

       1406
       1406
       -
           @return The mailbox if found

     

       1407
       1407
       -
           

     

       1408
       1408
       -
           Retrieves a single mailbox by its ID.

     

       1409
       1409
       -
       *)

     

       1410
       1410
       -
       val get_mailbox : 

     

       1411
       1411
       -
         connection -> 

     

       1412
       1412
       -
         account_id:Jmap.Types.id -> 

     

       1413
       1413
       -
         mailbox_id:Jmap.Types.id -> 

     

       1414
       1414
       -
         (Types.mailbox, Jmap.Api.error) result Lwt.t

     

       1415
       1415
       -
       

     

       1416
       1416
       -
       (** Get messages in a mailbox

     

       1417
       1417
       -
           @param conn The JMAP connection

     

       1418
       1418
       -
           @param account_id The account ID

     

       1419
       1419
       -
           @param mailbox_id The mailbox ID to get messages from

     

       1420
       1420
       -
           @param limit Optional limit on number of messages to return

     

       1421
       1421
       -
           @return The list of email messages if successful

     

       1422
       1422
       -
           

     

       1423
       1423
       -
           Retrieves email messages in the specified mailbox, with optional limit.

     

       1424
       1424
       -
       *)

     

       1425
       1425
       -
       val get_messages_in_mailbox : 

     

       1426
       1426
       -
         connection -> 

     

       1427
       1427
       -
         account_id:Jmap.Types.id -> 

     

       1428
       1428
       -
         mailbox_id:Jmap.Types.id -> 

     

       1429
       1429
       -
         ?limit:int -> 

     

       1430
       1430
       -
         unit -> 

     

       1431
       1431
       -
         (Types.email list, Jmap.Api.error) result Lwt.t

     

       1432
       1432
       -
       

     

       1433
       1433
       -
       (** Get a single email message by ID

     

       1434
       1434
       -
           @param conn The JMAP connection

     

       1435
       1435
       -
           @param account_id The account ID

     

       1436
       1436
       -
           @param email_id The email ID to retrieve

     

       1437
       1437
       -
           @return The email message if found

     

       1438
       1438
       -
           

     

       1439
       1439
       -
           Retrieves a single email message by its ID.

     

       1440
       1440
       -
       *)

     

       1441
       1441
       -
       val get_email : 

     

       1442
       1442
       -
         connection -> 

     

       1443
       1443
       -
         account_id:Jmap.Types.id -> 

     

       1444
       1444
       -
         email_id:Jmap.Types.id -> 

     

       1445
       1445
       -
         (Types.email, Jmap.Api.error) result Lwt.t

     

       1446
       1446
       -
         

     

       1447
       1447
       -
       (** Check if an email has a specific message keyword

     

       1448
       1448
       -
           @param email The email to check

     

       1449
       1449
       -
           @param keyword The message keyword to look for

     

       1450
       1450
       -
           @return true if the email has the keyword, false otherwise

     

       1451
       1451
       -
           

     

       1452
       1452
       -
           Tests whether an email has a particular keyword (flag) set.

     

       1453
       1453
       -
       *)

     

       1454
       1454
       -
       val has_message_keyword :

     

       1455
       1455
       -
         Types.email ->

     

       1456
       1456
       -
         Types.message_keyword ->

     

       1457
       1457
       -
         bool

     

       1458
       1458
       -
       

     

       1459
       1459
       -
       (** Add a message keyword to an email

     

       1460
       1460
       -
           @param conn The JMAP connection

     

       1461
       1461
       -
           @param account_id The account ID

     

       1462
       1462
       -
           @param email_id The email ID

     

       1463
       1463
       -
           @param keyword The message keyword to add

     

       1464
       1464
       -
           @return Success or error

     

       1465
       1465
       -
           

     

       1466
       1466
       -
           Adds a keyword (flag) to an email message.

     

       1467
       1467
       -
       *)

     

       1468
       1468
       -
       val add_message_keyword :

     

       1469
       1469
       -
         connection ->

     

       1470
       1470
       -
         account_id:Jmap.Types.id ->

     

       1471
       1471
       -
         email_id:Jmap.Types.id ->

     

       1472
       1472
       -
         keyword:Types.message_keyword ->

     

       1473
       1473
       -
         (unit, Jmap.Api.error) result Lwt.t

     

       1474
       1474
       -
       

     

       1475
       1475
       -
       (** Set a flag color for an email

     

       1476
       1476
       -
           @param conn The JMAP connection

     

       1477
       1477
       -
           @param account_id The account ID

     

       1478
       1478
       -
           @param email_id The email ID

     

       1479
       1479
       -
           @param color The flag color to set

     

       1480
       1480
       -
           @return Success or error

     

       1481
       1481
       -
           

     

       1482
       1482
       -
           Sets a flag color on an email message by setting the appropriate bit flags.

     

       1483
       1483
       -
       *)

     

       1484
       1484
       -
       val set_flag_color :

     

       1485
       1485
       -
         connection ->

     

       1486
       1486
       -
         account_id:Jmap.Types.id ->

     

       1487
       1487
       -
         email_id:Jmap.Types.id ->

     

       1488
       1488
       -
         color:Types.flag_color ->

     

       1489
       1489
       -
         (unit, Jmap.Api.error) result Lwt.t

     

       1490
       1490
       -
       

     

       1491
       1491
       -
       (** Convert an email's keywords to typed message_keyword list

     

       1492
       1492
       -
           @param email The email to analyze

     

       1493
       1493
       -
           @return List of message keywords

     

       1494
       1494
       -
           

     

       1495
       1495
       -
           Extracts all message keywords from an email's keyword list.

     

       1496
       1496
       -
       *)

     

       1497
       1497
       -
       val get_message_keywords :

     

       1498
       1498
       -
         Types.email ->

     

       1499
       1499
       -
         Types.message_keyword list

     

       1500
       1500
       -
       

     

       1501
       1501
       -
       (** Get emails with a specific message keyword

     

       1502
       1502
       -
           @param conn The JMAP connection

     

       1503
       1503
       -
           @param account_id The account ID

     

       1504
       1504
       -
           @param keyword The message keyword to search for

     

       1505
       1505
       -
           @param limit Optional limit on number of emails to return

     

       1506
       1506
       -
           @return List of emails with the keyword if successful

     

       1507
       1507
       -
           

     

       1508
       1508
       -
           Retrieves all emails that have a specific keyword (flag) set.

     

       1509
       1509
       -
       *)

     

       1510
       1510
       -
       val get_emails_with_keyword :

     

       1511
       1511
       -
         connection ->

     

       1512
       1512
       -
         account_id:Jmap.Types.id ->

     

       1513
       1513
       -
         keyword:Types.message_keyword ->

     

       1514
       1514
       -
         ?limit:int ->

     

       1515
       1515
       -
         unit ->

     

       1516
       1516
       -
         (Types.email list, Jmap.Api.error) result Lwt.t

     

       1517
       1517
       -
         

     

       1518
       1518
       -
       (** {1 Email Address Utilities}

     

       1519
       1519
       -
           Utilities for working with email addresses

     

       1520
       1520
       -
       *)

     

       1521
       1521
       -
       

     

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

     

       1523
       1523
       -
           @param email The email address to check

     

       1524
       1524
       -
           @param pattern The filter pattern to match against

     

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

     

       1526
       1526
       -
           

     

       1527
       1527
       -
           The filter supports simple wildcards:

     

       1528
       1528
       -
           - "*" matches any sequence of characters

     

       1529
       1529
       -
           - "?" matches any single character

     

       1530
       1530
       -
           - Case-insensitive matching is used

     

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

     

       1532
       1532
       -
       *)

     

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

     

       1534
       1534
       -
       

     

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

     

       1536
       1536
       -
           @param email The email object to check

     

       1537
       1537
       -
           @param pattern The sender filter pattern

     

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

     

       1539
       1539
       -
           

     

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

     

       1541
       1541
       -
       *)

     

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

Compare changes