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

.ocamlformat

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

+61 -4

bin/dune

···

       1
       1
        
       (executable

     

       2
       2
       -
        (name jmap_test)

     

       3
       3
       -
        (public_name jmap-test)

     

       4
       4
       -
        (package jmap-eio)

     

       5
       5
       -
        (libraries jmap-eio eio_main))

     

       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)

     

       39
       39
       +
        (package jmap)

     

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

     

       41
       41
       +
        (modules jmap_blob_downloader))

     

       42
       42
       +
       

     

       43
       43
       +
       (executable

     

       44
       44
       +
        (name jmap_email_composer)

     

       45
       45
       +
        (public_name jmap-email-composer)

     

       46
       46
       +
        (package jmap)

     

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

-298

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
       -
        *   --from=PATTERN    Filter messages by sender email address

     

       16
       16
       -
        *   --demo-refs       Demonstrate result references feature

     

       17
       17
       -
        *)

     

       18
       18
       -
       

     

       19
       19
       -
       open Lwt.Syntax

     

       20
       20
       -
       open Jmap

     

       21
       21
       -
       open Jmap_mail

     

       22
       22
       -
       open Cmdliner

     

       23
       23
       -
       module Mail = Jmap_mail.Types

     

       24
       24
       -
       

     

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

     

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

     

       27
       27
       -
         let sender = 

     

       28
       28
       -
           match email.from with

     

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

     

       30
       30
       -
               (match addr.name with

     

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

     

       32
       32
       -
               | None -> addr.email)

     

       33
       33
       -
           | _ -> "<unknown>"

     

       34
       34
       -
         in

     

       35
       35
       -
         let subject = 

     

       36
       36
       -
           match email.subject with

     

       37
       37
       -
           | Some s -> s

     

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

     

       39
       39
       -
         in

     

       40
       40
       -
         let date = email.received_at in

     

       41
       41
       -
         

     

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

     

       43
       43
       -
         let labels_str = 

     

       44
       44
       -
           if show_labels then

     

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

     

       46
       46
       -
             if formatted <> "" then

     

       47
       47
       -
               " [" ^ formatted ^ "]"

     

       48
       48
       -
             else

     

       49
       49
       -
               ""

     

       50
       50
       -
           else

     

       51
       51
       -
             ""

     

       52
       52
       -
         in

     

       53
       53
       -
         

     

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

     

       55
       55
       -
       

     

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

     

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

     

       58
       58
       -
         let is_unread_keyword = 

     

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

     

       60
       60
       -
             kw = Mail.Unread && active

     

       61
       61
       -
           ) email.keywords

     

       62
       62
       -
         in

     

       63
       63
       -
         let is_not_seen = 

     

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

     

       65
       65
       -
             kw = Mail.Seen && active

     

       66
       66
       -
           ) email.keywords)

     

       67
       67
       -
         in

     

       68
       68
       -
         is_unread_keyword || is_not_seen

     

       69
       69
       -
       

     

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

     

       71
       71
       -
       let demo_result_references conn account_id =

     

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

     

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

     

       74
       74
       -
         

     

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

     

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

     

       77
       77
       -
         match mailboxes_result with

     

       78
       78
       -
         | Error err ->

     

       79
       79
       -
             Printf.printf "Error getting mailboxes: %s\n" (Api.string_of_error err);

     

       80
       80
       -
             Lwt.return_unit

     

       81
       81
       -
             

     

       82
       82
       -
         | Ok mailboxes ->

     

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

     

       84
       84
       -
             match mailboxes with

     

       85
       85
       -
             | [] ->

     

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

     

       87
       87
       -
                 Lwt.return_unit

     

       88
       88
       -
                 

     

       89
       89
       -
             | first_mailbox :: _ ->

     

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

     

       91
       91
       -
                 

     

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

     

       93
       93
       -
                 let* emails_result = Jmap_mail.get_messages_in_mailbox

     

       94
       94
       -
                   conn

     

       95
       95
       -
                   ~account_id

     

       96
       96
       -
                   ~mailbox_id:first_mailbox.Mail.id

     

       97
       97
       -
                   ~limit:10

     

       98
       98
       -
                   ()

     

       99
       99
       -
                 in

     

       100
       100
       -
                 

     

       101
       101
       -
                 match emails_result with

     

       102
       102
       -
                 | Error err ->

     

       103
       103
       -
                     Printf.printf "Error getting emails: %s\n" (Api.string_of_error err);

     

       104
       104
       -
                     Lwt.return_unit

     

       105
       105
       -
                     

     

       106
       106
       -
                 | Ok emails ->

     

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

     

       108
       108
       -
                       (List.length emails);

     

       109
       109
       -
                       

     

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

     

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

     

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

     

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

     

       114
       114
       -
                     ) emails;

     

       115
       115
       -
                     

     

       116
       116
       -
                     Lwt.return_unit

     

       117
       117
       -
       

     

       118
       118
       -
       (** Main function for listing emails *)

     

       119
       119
       -
       let list_emails unread_only show_labels debug_level demo_refs sender_filter =

     

       120
       120
       -
         (* Configure logging *)

     

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

     

       122
       122
       -
         

     

       123
       123
       -
         match Sys.getenv_opt "JMAP_API_TOKEN" with

     

       124
       124
       -
         | None -> 

     

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

     

       126
       126
       -
             Printf.eprintf "Usage: JMAP_API_TOKEN=your_token fastmail-list [options]\n";

     

       127
       127
       -
             exit 1

     

       128
       128
       -
         | Some token ->

     

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

     

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

     

       131
       131
       -
             

     

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

     

       133
       133
       -
             let formatted_token = token in

     

       134
       134
       -
             

     

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

     

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

     

       137
       137
       -
               | None -> 0

     

       138
       138
       -
               | Some Logs.Error -> 1

     

       139
       139
       -
               | Some Logs.Info -> 2 

     

       140
       140
       -
               | Some Logs.Debug -> 3

     

       141
       141
       -
               | _ -> 2

     

       142
       142
       -
             in

     

       143
       143
       -
             if level >= 2 then begin

     

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

     

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

     

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

     

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

     

       148
       148
       -
               Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" fastmail-list [options]\n\n";

     

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

     

       150
       150
       -
             end;

     

       151
       151
       -
             let* result = login_with_token 

     

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

     

       153
       153
       -
               ~api_token:formatted_token

     

       154
       154
       -
             in

     

       155
       155
       -
             match result with

     

       156
       156
       -
             | Error err -> 

     

       157
       157
       -
                 Printf.eprintf "%s\n" (Api.string_of_error err);

     

       158
       158
       -
                 Lwt.return 1

     

       159
       159
       -
             | Ok conn ->

     

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

     

       161
       161
       -
                 let primary_account_id = 

     

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

     

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

     

       164
       164
       -
                   | Some id -> id

     

       165
       165
       -
                   | None -> 

     

       166
       166
       -
                       match conn.session.accounts with

     

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

     

       168
       168
       -
                       | [] -> 

     

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

     

       170
       170
       -
                           exit 1

     

       171
       171
       -
                 in

     

       172
       172
       -
                 

     

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

     

       174
       174
       -
                 let* () = 

     

       175
       175
       -
                   if demo_refs then

     

       176
       176
       -
                     demo_result_references conn primary_account_id

     

       177
       177
       -
                   else

     

       178
       178
       -
                     Lwt.return_unit

     

       179
       179
       -
                 in

     

       180
       180
       -
                 

     

       181
       181
       -
                 (* Get the Inbox mailbox *)

     

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

     

       183
       183
       -
                 match mailboxes_result with

     

       184
       184
       -
                 | Error err -> 

     

       185
       185
       -
                     Printf.eprintf "Failed to get mailboxes: %s\n" (Api.string_of_error err);

     

       186
       186
       -
                     Lwt.return 1

     

       187
       187
       -
                 | Ok mailboxes ->

     

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

     

       189
       189
       -
                     let inbox_id = 

     

       190
       190
       -
                       match mailboxes with

     

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

     

       192
       192
       -
                       | [] -> 

     

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

     

       194
       194
       -
                           exit 1

     

       195
       195
       -
                     in

     

       196
       196
       -
                     

     

       197
       197
       -
                     (* Get messages from inbox *)

     

       198
       198
       -
                     let* emails_result = get_messages_in_mailbox 

     

       199
       199
       -
                       conn 

     

       200
       200
       -
                       ~account_id:primary_account_id 

     

       201
       201
       -
                       ~mailbox_id:inbox_id

     

       202
       202
       -
                       ~limit:1000

     

       203
       203
       -
                       ()

     

       204
       204
       -
                     in

     

       205
       205
       -
                     match emails_result with

     

       206
       206
       -
                     | Error err -> 

     

       207
       207
       -
                         Printf.eprintf "Failed to get emails: %s\n" (Api.string_of_error err);

     

       208
       208
       -
                         Lwt.return 1

     

       209
       209
       -
                     | Ok emails ->

     

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

     

       211
       211
       -
                         let filtered_by_unread = 

     

       212
       212
       -
                           if unread_only then

     

       213
       213
       -
                             List.filter is_unread emails

     

       214
       214
       -
                           else 

     

       215
       215
       -
                             emails

     

       216
       216
       -
                         in

     

       217
       217
       -
                         

     

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

     

       219
       219
       -
                         let filtered_emails =

     

       220
       220
       -
                           if sender_filter <> "" then begin

     

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

     

       222
       222
       -
                             List.filter (fun email -> 

     

       223
       223
       -
                               Jmap_mail.email_matches_sender email sender_filter

     

       224
       224
       -
                             ) filtered_by_unread

     

       225
       225
       -
                           end else

     

       226
       226
       -
                             filtered_by_unread

     

       227
       227
       -
                         in

     

       228
       228
       -
                         

     

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

     

       230
       230
       -
                         let filter_description = 

     

       231
       231
       -
                           let parts = [] in

     

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

     

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

     

       234
       234
       -
                           match parts with

     

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

     

       236
       236
       -
                           | [p] -> p

     

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

     

       238
       238
       -
                         in

     

       239
       239
       -
                         

     

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

     

       241
       241
       -
                           filter_description

     

       242
       242
       -
                           (List.length filtered_emails);

     

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

     

       244
       244
       -
                         List.iter (print_email ~show_labels) filtered_emails;

     

       245
       245
       -
                         Lwt.return 0

     

       246
       246
       -
       

     

       247
       247
       -
       (** Command line interface *)

     

       248
       248
       -
       let unread_only =

     

       249
       249
       -
         let doc = "List only unread messages" in

     

       250
       250
       -
         Arg.(value & flag & info ["unread"] ~doc)

     

       251
       251
       -
       

     

       252
       252
       -
       let show_labels =

     

       253
       253
       -
         let doc = "Show labels/keywords associated with messages" in

     

       254
       254
       -
         Arg.(value & flag & info ["labels"] ~doc)

     

       255
       255
       -
       

     

       256
       256
       -
       let debug_level =

     

       257
       257
       -
         let doc = "Set debug level (0-4, where 4 is most verbose)" in

     

       258
       258
       -
         Arg.(value & opt int 0 & info ["debug"] ~docv:"LEVEL" ~doc)

     

       259
       259
       -
       

     

       260
       260
       -
       let demo_refs =

     

       261
       261
       -
         let doc = "Demonstrate result references feature" in

     

       262
       262
       -
         Arg.(value & flag & info ["demo-refs"] ~doc)

     

       263
       263
       -
       

     

       264
       264
       -
       let sender_filter =

     

       265
       265
       -
         let doc = "Filter messages by sender email address (supports wildcards: * and ?)" in

     

       266
       266
       -
         Arg.(value & opt string "" & info ["from"] ~docv:"PATTERN" ~doc)

     

       267
       267
       -
       

     

       268
       268
       -
       let cmd =

     

       269
       269
       -
         let doc = "List emails from a Fastmail account using JMAP API" in

     

       270
       270
       -
         let man = [

     

       271
       271
       -
           `S Manpage.s_description;

     

       272
       272
       -
           `P "This program connects to the Fastmail JMAP API using an authentication token 

     

       273
       273
       -
               from the JMAP_API_TOKEN environment variable and lists the most recent emails 

     

       274
       274
       -
               with their subjects, sender details, and labels.";

     

       275
       275
       -
           `P "You must obtain a Fastmail API token from https://app.fastmail.com/settings/tokens 

     

       276
       276
       -
               and set it in the JMAP_API_TOKEN environment variable.";

     

       277
       277
       -
           `S Manpage.s_environment;

     

       278
       278
       -
           `P "$(b,JMAP_API_TOKEN) The Fastmail API authentication token (required)";

     

       279
       279
       -
           `S Manpage.s_examples;

     

       280
       280
       -
           `P "List all emails:";

     

       281
       281
       -
           `P "  $(mname) $(i,JMAP_API_TOKEN=your_token)";

     

       282
       282
       -
           `P "List only unread emails:";

     

       283
       283
       -
           `P "  $(mname) $(i,JMAP_API_TOKEN=your_token) --unread";

     

       284
       284
       -
           `P "List emails from a specific sender:";

     

       285
       285
       -
           `P "  $(mname) $(i,JMAP_API_TOKEN=your_token) --from=user@example.com";

     

       286
       286
       -
           `P "List unread emails with labels:";

     

       287
       287
       -
           `P "  $(mname) $(i,JMAP_API_TOKEN=your_token) --unread --labels";

     

       288
       288
       -
         ] in

     

       289
       289
       -
         let info = Cmd.info "fastmail-list" ~doc ~man in

     

       290
       290
       -
         Cmd.v info Term.(const (fun u l d r s -> 

     

       291
       291
       -
           Lwt_main.run (list_emails u l d r s)

     

       292
       292
       -
         ) $ unread_only $ show_labels $ debug_level $ demo_refs $ sender_filter)

     

       293
       293
       -
       

     

       294
       294
       -
       (** Program entry point *)

     

       295
       295
       -
       let () = exit (Cmd.eval_value cmd |> function

     

       296
       296
       -
         | Ok (`Ok exit_code) -> exit_code

     

       297
       297
       -
         | Ok (`Version | `Help) -> 0

     

       298
       298
       -
         | Error _ -> 1)

-177

bin/fastmail_send.ml

···

       1
       1
       -
       (** JMAP email sending utility for Fastmail

     

       2
       2
       -
           

     

       3
       3
       -
           This utility sends an email via JMAP to recipients specified on the command line.

     

       4
       4
       -
           The subject is provided as a command-line argument, and the message body is read

     

       5
       5
       -
           from standard input.

     

       6
       6
       -
           

     

       7
       7
       -
           Usage:

     

       8
       8
       -
           fastmail_send --to=recipient@example.com [--to=another@example.com ...] --subject="Email subject"

     

       9
       9
       -
           

     

       10
       10
       -
           Environment variables:

     

       11
       11
       -
           - JMAP_API_TOKEN: Required. The Fastmail API token for authentication.

     

       12
       12
       -
           - JMAP_FROM_EMAIL: Optional. The sender's email address. If not provided, uses the first identity.

     

       13
       13
       -
           

     

       14
       14
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7> RFC8621 Section 7

     

       15
       15
       -
       *)

     

       16
       16
       -
       

     

       17
       17
       -
       open Lwt.Syntax

     

       18
       18
       -
       open Cmdliner

     

       19
       19
       -
       

     

       20
       20
       -
       let log_error fmt = Fmt.epr ("\u{1b}[1;31mError: \u{1b}[0m" ^^ fmt ^^ "@.")

     

       21
       21
       -
       let log_info fmt = Fmt.pr ("\u{1b}[1;34mInfo: \u{1b}[0m" ^^ fmt ^^ "@.")

     

       22
       22
       -
       let log_success fmt = Fmt.pr ("\u{1b}[1;32mSuccess: \u{1b}[0m" ^^ fmt ^^ "@.")

     

       23
       23
       -
       

     

       24
       24
       -
       (** Read the entire message body from stdin *)

     

       25
       25
       -
       let read_message_body () =

     

       26
       26
       -
         let buffer = Buffer.create 1024 in

     

       27
       27
       -
         let rec read_lines () =

     

       28
       28
       -
           try

     

       29
       29
       -
             let line = input_line stdin in

     

       30
       30
       -
             Buffer.add_string buffer line;

     

       31
       31
       -
             Buffer.add_char buffer '\n';

     

       32
       32
       -
             read_lines ()

     

       33
       33
       -
           with

     

       34
       34
       -
           | End_of_file -> Buffer.contents buffer

     

       35
       35
       -
         in

     

       36
       36
       -
         read_lines ()

     

       37
       37
       -
       

     

       38
       38
       -
       (** Main function to send an email *)

     

       39
       39
       -
       let send_email to_addresses subject from_email =

     

       40
       40
       -
         (* Check for API token in environment *)

     

       41
       41
       -
         match Sys.getenv_opt "JMAP_API_TOKEN" with

     

       42
       42
       -
         | None -> 

     

       43
       43
       -
             log_error "JMAP_API_TOKEN environment variable not set";

     

       44
       44
       -
             exit 1

     

       45
       45
       -
         | Some token ->

     

       46
       46
       -
             (* Read message body from stdin *)

     

       47
       47
       -
             log_info "Reading message body from stdin (press Ctrl+D when finished)...";

     

       48
       48
       -
             let message_body = read_message_body () in

     

       49
       49
       -
             if message_body = "" then

     

       50
       50
       -
               log_info "No message body entered, using a blank message";

     

       51
       51
       -
             

     

       52
       52
       -
             (* Initialize JMAP connection *)

     

       53
       53
       -
             let fastmail_uri = "https://api.fastmail.com/jmap/session" in

     

       54
       54
       -
             Lwt_main.run begin

     

       55
       55
       -
               let* conn_result = Jmap_mail.login_with_token ~uri:fastmail_uri ~api_token:token in

     

       56
       56
       -
               match conn_result with

     

       57
       57
       -
               | Error err ->

     

       58
       58
       -
                   let msg = Jmap.Api.string_of_error err in

     

       59
       59
       -
                   log_error "Failed to connect to Fastmail: %s" msg;

     

       60
       60
       -
                   Lwt.return 1

     

       61
       61
       -
               | Ok conn ->

     

       62
       62
       -
                   (* Get primary account ID *)

     

       63
       63
       -
                   let account_id =

     

       64
       64
       -
                     (* Get the primary account - first personal account in the list *)

     

       65
       65
       -
                     let (_, _account) = List.find (fun (_, acc) -> 

     

       66
       66
       -
                       acc.Jmap.Types.is_personal) conn.session.accounts in

     

       67
       67
       -
                     (* Use the first account id as primary *)

     

       68
       68
       -
                     (match conn.session.primary_accounts with

     

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

     

       70
       70
       -
                      | [] -> 

     

       71
       71
       -
                         (* Fallback if no primary accounts defined *)

     

       72
       72
       -
                         let (id, _) = List.hd conn.session.accounts in

     

       73
       73
       -
                         id)

     

       74
       74
       -
                   in

     

       75
       75
       -
                   

     

       76
       76
       -
                   (* Determine sender email address *)

     

       77
       77
       -
                   let* from_email_result = match from_email with

     

       78
       78
       -
                     | Some email -> Lwt.return_ok email

     

       79
       79
       -
                     | None -> 

     

       80
       80
       -
                         (* Get first available identity *)

     

       81
       81
       -
                         let* identities_result = Jmap_mail.get_identities conn ~account_id in

     

       82
       82
       -
                         match identities_result with

     

       83
       83
       -
                         | Ok [] -> 

     

       84
       84
       -
                             log_error "No identities found for account";

     

       85
       85
       -
                             Lwt.return_error "No identities found"

     

       86
       86
       -
                         | Ok (identity :: _) -> Lwt.return_ok identity.email

     

       87
       87
       -
                         | Error err -> 

     

       88
       88
       -
                             let msg = Jmap.Api.string_of_error err in

     

       89
       89
       -
                             log_error "Failed to get identities: %s" msg;

     

       90
       90
       -
                             Lwt.return_error msg

     

       91
       91
       -
                   in

     

       92
       92
       -
                   

     

       93
       93
       -
                   match from_email_result with

     

       94
       94
       -
                   | Error _msg -> Lwt.return 1

     

       95
       95
       -
                   | Ok from_email ->

     

       96
       96
       -
                       (* Send the email *)

     

       97
       97
       -
                       log_info "Sending email from %s to %s" 

     

       98
       98
       -
                         from_email 

     

       99
       99
       -
                         (String.concat ", " to_addresses);

     

       100
       100
       -
                       

     

       101
       101
       -
                       let* submission_result = 

     

       102
       102
       -
                         Jmap_mail.create_and_submit_email 

     

       103
       103
       -
                           conn 

     

       104
       104
       -
                           ~account_id 

     

       105
       105
       -
                           ~from:from_email

     

       106
       106
       -
                           ~to_addresses 

     

       107
       107
       -
                           ~subject 

     

       108
       108
       -
                           ~text_body:message_body 

     

       109
       109
       -
                           ()

     

       110
       110
       -
                       in

     

       111
       111
       -
                       

     

       112
       112
       -
                       match submission_result with

     

       113
       113
       -
                       | Error err ->

     

       114
       114
       -
                           let msg = Jmap.Api.string_of_error err in

     

       115
       115
       -
                           log_error "Failed to send email: %s" msg;

     

       116
       116
       -
                           Lwt.return 1

     

       117
       117
       -
                       | Ok submission_id ->

     

       118
       118
       -
                           log_success "Email sent successfully (Submission ID: %s)" submission_id;

     

       119
       119
       -
                           (* Wait briefly then check submission status *)

     

       120
       120
       -
                           let* () = Lwt_unix.sleep 1.0 in

     

       121
       121
       -
                           let* status_result = Jmap_mail.get_submission_status 

     

       122
       122
       -
                               conn 

     

       123
       123
       -
                               ~account_id 

     

       124
       124
       -
                               ~submission_id

     

       125
       125
       -
                           in

     

       126
       126
       -
                           

     

       127
       127
       -
                           (match status_result with

     

       128
       128
       -
                           | Ok status ->

     

       129
       129
       -
                               let status_text = match status.Jmap_mail.Types.undo_status with

     

       130
       130
       -
                                 | Some `pending -> "Pending"

     

       131
       131
       -
                                 | Some `final -> "Final (delivered)"

     

       132
       132
       -
                                 | Some `canceled -> "Canceled"

     

       133
       133
       -
                                 | None -> "Unknown"

     

       134
       134
       -
                               in

     

       135
       135
       -
                               log_info "Submission status: %s" status_text;

     

       136
       136
       -
                               

     

       137
       137
       -
                               (match status.Jmap_mail.Types.delivery_status with

     

       138
       138
       -
                               | Some statuses ->

     

       139
       139
       -
                                   List.iter (fun (email, status) ->

     

       140
       140
       -
                                     let delivery = match status.Jmap_mail.Types.delivered with

     

       141
       141
       -
                                       | Some "yes" -> "Delivered"

     

       142
       142
       -
                                       | Some "no" -> "Failed"

     

       143
       143
       -
                                       | Some "queued" -> "Queued"

     

       144
       144
       -
                                       | Some s -> s

     

       145
       145
       -
                                       | None -> "Unknown"

     

       146
       146
       -
                                     in

     

       147
       147
       -
                                     log_info "Delivery to %s: %s" email delivery

     

       148
       148
       -
                                   ) statuses

     

       149
       149
       -
                               | None -> ());

     

       150
       150
       -
                               Lwt.return 0

     

       151
       151
       -
                           | Error _ ->

     

       152
       152
       -
                               (* We don't fail if status check fails, as the email might still be sent *)

     

       153
       153
       -
                               Lwt.return 0)

     

       154
       154
       -
             end

     

       155
       155
       -
       

     

       156
       156
       -
       (** Command line interface *)

     

       157
       157
       -
       let to_addresses =

     

       158
       158
       -
         let doc = "Email address of the recipient (can be specified multiple times)" in

     

       159
       159
       -
         Arg.(value & opt_all string [] & info ["to"] ~docv:"EMAIL" ~doc)

     

       160
       160
       -
       

     

       161
       161
       -
       let subject =

     

       162
       162
       -
         let doc = "Subject line for the email" in

     

       163
       163
       -
         Arg.(required & opt (some string) None & info ["subject"] ~docv:"SUBJECT" ~doc)

     

       164
       164
       -
       

     

       165
       165
       -
       let from_email =

     

       166
       166
       -
         let doc = "Sender's email address (optional, defaults to primary identity)" in

     

       167
       167
       -
         Arg.(value & opt (some string) None & info ["from"] ~docv:"EMAIL" ~doc)

     

       168
       168
       -
       

     

       169
       169
       -
       let cmd =

     

       170
       170
       -
         let doc = "Send an email via JMAP to Fastmail" in

     

       171
       171
       -
         let info = Cmd.info "fastmail_send" ~doc in

     

       172
       172
       -
         Cmd.v info Term.(const send_email $ to_addresses $ subject $ from_email)

     

       173
       173
       -
       

     

       174
       174
       -
       let () = match Cmd.eval_value cmd with

     

       175
       175
       -
         | Ok (`Ok code) -> exit code

     

       176
       176
       -
         | Ok (`Version | `Help) -> exit 0

     

       177
       177
       -
         | Error _ -> exit 1

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

-141

bin/jmap_test.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP test client - connects to a JMAP server and queries recent emails *)

     

       7
       7
       -
       

     

       8
       8
       -
       let () =

     

       9
       9
       -
         (* Parse command line arguments *)

     

       10
       10
       -
         let usage = "Usage: jmap-test <session-url> <api-key>" in

     

       11
       11
       -
         let args = ref [] in

     

       12
       12
       -
         Arg.parse [] (fun arg -> args := arg :: !args) usage;

     

       13
       13
       -
         let session_url, api_key =

     

       14
       14
       -
           match List.rev !args with

     

       15
       15
       -
           | [url; key] -> (url, key)

     

       16
       16
       -
           | _ ->

     

       17
       17
       -
               prerr_endline usage;

     

       18
       18
       -
               exit 1

     

       19
       19
       -
         in

     

       20
       20
       -
       

     

       21
       21
       -
         (* Run with Eio *)

     

       22
       22
       -
         Eio_main.run @@ fun env ->

     

       23
       23
       -
         Eio.Switch.run @@ fun sw ->

     

       24
       24
       -
       

     

       25
       25
       -
         (* Create HTTP client with Bearer token auth *)

     

       26
       26
       -
         let requests = Requests.create ~sw env in

     

       27
       27
       -
         let auth = Requests.Auth.bearer ~token:api_key in

     

       28
       28
       -
       

     

       29
       29
       -
         Printf.printf "Connecting to %s...\n%!" session_url;

     

       30
       30
       -
       

     

       31
       31
       -
         (* Create JMAP client from session URL *)

     

       32
       32
       -
         match Jmap_eio.Client.create_from_url ~auth requests session_url with

     

       33
       33
       -
         | Error e ->

     

       34
       34
       -
             Printf.eprintf "Failed to connect: %s\n" (Jmap_eio.Client.error_to_string e);

     

       35
       35
       -
             exit 1

     

       36
       36
       -
         | Ok client ->

     

       37
       37
       -
             let session = Jmap_eio.Client.session client in

     

       38
       38
       -
             Printf.printf "Connected! Username: %s\n%!" (Jmap_proto.Session.username session);

     

       39
       39
       -
       

     

       40
       40
       -
             (* Get primary mail account *)

     

       41
       41
       -
             let primary_account_id =

     

       42
       42
       -
               match Jmap_proto.Session.primary_account_for Jmap_proto.Capability.mail session with

     

       43
       43
       -
               | Some id -> id

     

       44
       44
       -
               | None ->

     

       45
       45
       -
                   prerr_endline "No primary mail account found";

     

       46
       46
       -
                   exit 1

     

       47
       47
       -
             in

     

       48
       48
       -
             Printf.printf "Primary mail account: %s\n%!" (Jmap_proto.Id.to_string primary_account_id);

     

       49
       49
       -
       

     

       50
       50
       -
             (* Query for recent emails - get the 10 most recent *)

     

       51
       51
       -
             let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in

     

       52
       52
       -
             let query_inv = Jmap_eio.Client.Build.email_query

     

       53
       53
       -
               ~call_id:"q1"

     

       54
       54
       -
               ~account_id:primary_account_id

     

       55
       55
       -
               ~sort

     

       56
       56
       -
               ~limit:10L

     

       57
       57
       -
               ()

     

       58
       58
       -
             in

     

       59
       59
       -
       

     

       60
       60
       -
             (* Build request with mail capability *)

     

       61
       61
       -
             let req = Jmap_eio.Client.Build.make_request

     

       62
       62
       -
               ~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]

     

       63
       63
       -
               [query_inv]

     

       64
       64
       -
             in

     

       65
       65
       -
       

     

       66
       66
       -
             Printf.printf "Querying recent emails...\n%!";

     

       67
       67
       -
       

     

       68
       68
       -
             match Jmap_eio.Client.request client req with

     

       69
       69
       -
             | Error e ->

     

       70
       70
       -
                 Printf.eprintf "Query failed: %s\n" (Jmap_eio.Client.error_to_string e);

     

       71
       71
       -
                 exit 1

     

       72
       72
       -
             | Ok response ->

     

       73
       73
       -
                 (* Parse the query response *)

     

       74
       74
       -
                 match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with

     

       75
       75
       -
                 | Error e ->

     

       76
       76
       -
                     Printf.eprintf "Failed to parse query response: %s\n" (Jsont.Error.to_string e);

     

       77
       77
       -
                     exit 1

     

       78
       78
       -
                 | Ok query_result ->

     

       79
       79
       -
                     let email_ids = query_result.ids in

     

       80
       80
       -
                     Printf.printf "Found %d emails\n%!" (List.length email_ids);

     

       81
       81
       -
       

     

       82
       82
       -
                     if List.length email_ids = 0 then (

     

       83
       83
       -
                       Printf.printf "No emails found.\n%!";

     

       84
       84
       -
                     ) else (

     

       85
       85
       -
                       (* Fetch the email details *)

     

       86
       86
       -
                       let get_inv = Jmap_eio.Client.Build.email_get

     

       87
       87
       -
                         ~call_id:"g1"

     

       88
       88
       -
                         ~account_id:primary_account_id

     

       89
       89
       -
                         ~ids:email_ids

     

       90
       90
       -
                         ~properties:["id"; "subject"; "from"; "receivedAt"; "preview"]

     

       91
       91
       -
                         ()

     

       92
       92
       -
                       in

     

       93
       93
       -
       

     

       94
       94
       -
                       let req2 = Jmap_eio.Client.Build.make_request

     

       95
       95
       -
                         ~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]

     

       96
       96
       -
                         [get_inv]

     

       97
       97
       -
                       in

     

       98
       98
       -
       

     

       99
       99
       -
                       Printf.printf "Fetching email details...\n%!";

     

       100
       100
       -
       

     

       101
       101
       -
                       match Jmap_eio.Client.request client req2 with

     

       102
       102
       -
                       | Error e ->

     

       103
       103
       -
                           Printf.eprintf "Get failed: %s\n" (Jmap_eio.Client.error_to_string e);

     

       104
       104
       -
                           exit 1

     

       105
       105
       -
                       | Ok response2 ->

     

       106
       106
       -
                           match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with

     

       107
       107
       -
                           | Error e ->

     

       108
       108
       -
                               Printf.eprintf "Failed to parse get response: %s\n" (Jsont.Error.to_string e);

     

       109
       109
       -
                               exit 1

     

       110
       110
       -
                           | Ok get_result ->

     

       111
       111
       -
                               Printf.printf "\n=== Recent Emails ===\n\n%!";

     

       112
       112
       -
                               List.iter (fun email ->

     

       113
       113
       -
                                 let id = Jmap_proto.Id.to_string (Jmap_mail.Email.id email) in

     

       114
       114
       -
                                 let subject = Option.value (Jmap_mail.Email.subject email) ~default:"(no subject)" in

     

       115
       115
       -
                                 let from_addrs = Option.value (Jmap_mail.Email.from email) ~default:[] in

     

       116
       116
       -
                                 let from_str = match from_addrs with

     

       117
       117
       -
                                   | [] -> "(unknown sender)"

     

       118
       118
       -
                                   | addr :: _ ->

     

       119
       119
       -
                                       let name = Option.value (Jmap_mail.Email_address.name addr) ~default:"" in

     

       120
       120
       -
                                       let email_addr = Jmap_mail.Email_address.email addr in

     

       121
       121
       -
                                       if name = "" then email_addr

     

       122
       122
       -
                                       else Printf.sprintf "%s <%s>" name email_addr

     

       123
       123
       -
                                 in

     

       124
       124
       -
                                 let received =

     

       125
       125
       -
                                   Jmap_proto.Date.Utc.to_string (Jmap_mail.Email.received_at email)

     

       126
       126
       -
                                 in

     

       127
       127
       -
                                 let preview = Jmap_mail.Email.preview email in

     

       128
       128
       -
                                 let preview_short =

     

       129
       129
       -
                                   if String.length preview > 80 then

     

       130
       130
       -
                                     String.sub preview 0 77 ^ "..."

     

       131
       131
       -
                                   else preview

     

       132
       132
       -
                                 in

     

       133
       133
       -
                                 Printf.printf "ID: %s\n" id;

     

       134
       134
       -
                                 Printf.printf "From: %s\n" from_str;

     

       135
       135
       -
                                 Printf.printf "Date: %s\n" received;

     

       136
       136
       -
                                 Printf.printf "Subject: %s\n" subject;

     

       137
       137
       -
                                 Printf.printf "Preview: %s\n" preview_short;

     

       138
       138
       -
                                 Printf.printf "\n%!";

     

       139
       139
       -
                               ) get_result.list;

     

       140
       140
       -
                               Printf.printf "=== End of emails ===\n%!"

     

       141
       141
       -
                     )

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

-164

bin/tutorial_examples.ml

···

       1
       1
       -
       (* Examples from the tutorial *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Lwt.Syntax

     

       4
       4
       -
       open Jmap

     

       5
       5
       -
       open Jmap_mail

     

       6
       6
       -
       

     

       7
       7
       -
       (* Example: Authentication *)

     

       8
       8
       -
       let auth_example () =

     

       9
       9
       -
         (* Using a Fastmail API token *)

     

       10
       10
       -
         let token = Sys.getenv_opt "JMAP_API_TOKEN" in

     

       11
       11
       -
         match token with

     

       12
       12
       -
         | None ->

     

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

     

       14
       14
       -
             Lwt.return_none

     

       15
       15
       -
         | Some token ->

     

       16
       16
       -
             let+ result = Jmap_mail.login_with_token 

     

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

     

       18
       18
       -
               ~api_token:token

     

       19
       19
       -
             in

     

       20
       20
       -
         

     

       21
       21
       -
             (* Handle the result *)

     

       22
       22
       -
             match result with

     

       23
       23
       -
             | Ok conn -> 

     

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

     

       25
       25
       -
                 let account_id = 

     

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

     

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

     

       28
       28
       -
                   | Some id -> id

     

       29
       29
       -
                   | None -> 

     

       30
       30
       -
                       match conn.session.accounts with

     

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

     

       32
       32
       -
                       | [] -> failwith "No accounts found"

     

       33
       33
       -
                 in

     

       34
       34
       -
                 Printf.printf "Authenticated successfully with account ID: %s\n" account_id;

     

       35
       35
       -
                 Some (conn, account_id)

     

       36
       36
       -
             | Error e -> 

     

       37
       37
       -
                 Printf.eprintf "Authentication error: %s\n" 

     

       38
       38
       -
                   (match e with

     

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

     

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

     

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

     

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

     

       43
       43
       -
                 None

     

       44
       44
       -
       

     

       45
       45
       -
       (* Example: Working with Mailboxes *)

     

       46
       46
       -
       let mailbox_example (conn, account_id) =

     

       47
       47
       -
         (* Get all mailboxes *)

     

       48
       48
       -
         let+ mailboxes_result = Jmap_mail.get_mailboxes conn ~account_id in

     

       49
       49
       -
         

     

       50
       50
       -
         match mailboxes_result with

     

       51
       51
       -
         | Ok mailboxes -> 

     

       52
       52
       -
             Printf.printf "Found %d mailboxes\n" (List.length mailboxes);

     

       53
       53
       -
             

     

       54
       54
       -
             (* Find inbox - for simplicity, just use the first mailbox *)

     

       55
       55
       -
             let inbox = match mailboxes with

     

       56
       56
       -
               | first :: _ -> Some first

     

       57
       57
       -
               | [] -> None

     

       58
       58
       -
             in

     

       59
       59
       -
             

     

       60
       60
       -
             (match inbox with

     

       61
       61
       -
             | Some m -> 

     

       62
       62
       -
                 Printf.printf "Inbox ID: %s, Name: %s\n" 

     

       63
       63
       -
                   m.Types.id 

     

       64
       64
       -
                   m.Types.name;

     

       65
       65
       -
                 Some (conn, account_id, m.Types.id)

     

       66
       66
       -
             | None -> 

     

       67
       67
       -
                 Printf.printf "No inbox found\n";

     

       68
       68
       -
                 None)

     

       69
       69
       -
         | Error e -> 

     

       70
       70
       -
             Printf.eprintf "Error getting mailboxes: %s\n" 

     

       71
       71
       -
               (match e with

     

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

     

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

     

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

     

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

     

       76
       76
       -
             None

     

       77
       77
       -
       

     

       78
       78
       -
       (* Example: Working with Emails *)

     

       79
       79
       -
       let email_example (conn, account_id, mailbox_id) =

     

       80
       80
       -
         (* Get emails from mailbox *)

     

       81
       81
       -
         let+ emails_result = Jmap_mail.get_messages_in_mailbox

     

       82
       82
       -
           conn

     

       83
       83
       -
           ~account_id

     

       84
       84
       -
           ~mailbox_id

     

       85
       85
       -
           ~limit:5

     

       86
       86
       -
           ()

     

       87
       87
       -
         in

     

       88
       88
       -
         

     

       89
       89
       -
         match emails_result with

     

       90
       90
       -
         | Ok emails -> begin

     

       91
       91
       -
             Printf.printf "Found %d emails\n" (List.length emails);

     

       92
       92
       -
             

     

       93
       93
       -
             (* Display emails *)

     

       94
       94
       -
             List.iter (fun (email:Jmap_mail.Types.email) ->

     

       95
       95
       -
               (* Using explicit module path for Types to avoid ambiguity *)

     

       96
       96
       -
               let module Mail = Jmap_mail.Types in

     

       97
       97
       -
               

     

       98
       98
       -
               (* Get sender info *)

     

       99
       99
       -
               let from = match email.Mail.from with

     

       100
       100
       -
                 | None -> "Unknown"

     

       101
       101
       -
                 | Some addrs -> 

     

       102
       102
       -
                     match addrs with

     

       103
       103
       -
                     | [] -> "Unknown"

     

       104
       104
       -
                     | addr :: _ -> 

     

       105
       105
       -
                         match addr.Mail.name with

     

       106
       106
       -
                         | None -> addr.Mail.email

     

       107
       107
       -
                         | Some name -> 

     

       108
       108
       -
                             Printf.sprintf "%s <%s>" name addr.Mail.email

     

       109
       109
       -
               in

     

       110
       110
       -
               

     

       111
       111
       -
               (* Check for unread status *)

     

       112
       112
       -
               let is_unread =

     

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

     

       114
       114
       -
                   match kw with

     

       115
       115
       -
                   | Mail.Unread -> active

     

       116
       116
       -
                   | Mail.Custom s when s = "$unread" -> active

     

       117
       117
       -
                   | _ -> false

     

       118
       118
       -
                 ) email.Mail.keywords

     

       119
       119
       -
               in

     

       120
       120
       -
               

     

       121
       121
       -
               (* Display email info *)

     

       122
       122
       -
               Printf.printf "[%s] %s - %s\n"

     

       123
       123
       -
                 (if is_unread then "UNREAD" else "READ")

     

       124
       124
       -
                 from

     

       125
       125
       -
                 (Option.value ~default:"(No Subject)" email.Mail.subject)

     

       126
       126
       -
             ) emails;

     

       127
       127
       -
             

     

       128
       128
       -
             match emails with

     

       129
       129
       -
             | [] -> None

     

       130
       130
       -
             | hd::_ -> Some (conn, account_id, hd.Jmap_mail.Types.id)

     

       131
       131
       -
         end

     

       132
       132
       -
         | Error e ->

     

       133
       133
       -
             Printf.eprintf "Error getting emails: %s\n" 

     

       134
       134
       -
               (match e with

     

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

     

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

     

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

     

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

     

       139
       139
       -
             None

     

       140
       140
       -
       

     

       141
       141
       -
       (* Run examples with Lwt *)

     

       142
       142
       -
       let () =

     

       143
       143
       -
         (* Set up logging *)

     

       144
       144
       -
         Jmap.init_logging ~level:2 ~enable_logs:true ~redact_sensitive:true ();

     

       145
       145
       -
         

     

       146
       146
       -
         (* Run the examples in sequence *)

     

       147
       147
       -
         let result = Lwt_main.run (

     

       148
       148
       -
           let* auth_result = auth_example () in

     

       149
       149
       -
           match auth_result with

     

       150
       150
       -
           | None -> Lwt.return 1

     

       151
       151
       -
           | Some conn_account ->

     

       152
       152
       -
               let* mailbox_result = mailbox_example conn_account in

     

       153
       153
       -
               match mailbox_result with

     

       154
       154
       -
               | None -> Lwt.return 1

     

       155
       155
       -
               | Some conn_account_mailbox ->

     

       156
       156
       -
                   let* email_result = email_example conn_account_mailbox in

     

       157
       157
       -
                   match email_result with

     

       158
       158
       -
                   | None -> Lwt.return 1

     

       159
       159
       -
                   | Some _ -> 

     

       160
       160
       -
                       Printf.printf "All examples completed successfully\n";

     

       161
       161
       -
                       Lwt.return 0

     

       162
       162
       -
         ) in

     

       163
       163
       -
         

     

       164
       164
       -
         exit result

+1 -37

dune-project

···

       1
       1
       -
       (lang dune 3.0)

     

       2
       2
       -
       

     

       3
       3
       -
       (name jmap)

     

       4
       4
       -
       

     

       5
       5
       -
       (generate_opam_files true)

     

       6
       6
       -
       

     

       7
       7
       -
       (source

     

       8
       8
       -
        (github avsm/ocaml-jmap))

     

       9
       9
       -
       

     

       10
       10
       -
       (authors "Anil Madhavapeddy <anil@recoil.org>")

     

       11
       11
       -
       

     

       12
       12
       -
       (maintainers "Anil Madhavapeddy <anil@recoil.org>")

     

       13
       13
       -
       

     

       14
       14
       -
       (license ISC)

     

       15
       15
       -
       

     

       16
       16
       -
       (documentation https://avsm.github.io/ocaml-jmap)

     

       17
       17
       -
       

     

       18
       18
       -
       (package

     

       19
       19
       -
        (name jmap)

     

       20
       20
       -
        (synopsis "JMAP protocol implementation for OCaml")

     

       21
       21
       -
        (description

     

       22
       22
       -
         "A complete implementation of the JSON Meta Application Protocol (JMAP) as specified in RFC 8620 (core) and RFC 8621 (mail).")

     

       23
       23
       -
        (depends

     

       24
       24
       -
         (ocaml (>= 4.14.0))

     

       25
       25
       -
         (jsont (>= 0.2.0))

     

       26
       26
       -
         (ptime (>= 1.0.0))))

     

       27
       27
       -
       

     

       28
       28
       -
       (package

     

       29
       29
       -
        (name jmap-eio)

     

       30
       30
       -
        (synopsis "JMAP client for Eio")

     

       31
       31
       -
        (description "High-level JMAP client using Eio for async I/O and the Requests HTTP library.")

     

       32
       32
       -
        (depends

     

       33
       33
       -
         (ocaml (>= 4.14.0))

     

       34
       34
       -
         (jmap (= :version))

     

       35
       35
       -
         (jsont (>= 0.2.0))

     

       36
       36
       -
         eio

     

       37
       37
       -
         requests))

     

       1
       1
       +
       (lang dune 3.17)

-514

eio/client.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type error =

     

       7
       7
       -
         | Http_error of int * string

     

       8
       8
       -
         | Jmap_error of Jmap_proto.Error.Request_error.t

     

       9
       9
       -
         | Json_error of Jsont.Error.t

     

       10
       10
       -
         | Session_error of string

     

       11
       11
       -
         | Connection_error of string

     

       12
       12
       -
       

     

       13
       13
       -
       let pp_error fmt = function

     

       14
       14
       -
         | Http_error (code, msg) ->

     

       15
       15
       -
             Format.fprintf fmt "HTTP error %d: %s" code msg

     

       16
       16
       -
         | Jmap_error err ->

     

       17
       17
       -
             Format.fprintf fmt "JMAP error: %s"

     

       18
       18
       -
               (Jmap_proto.Error.Request_error.urn_to_string err.type_)

     

       19
       19
       -
         | Json_error err ->

     

       20
       20
       -
             Format.fprintf fmt "JSON error: %s" (Jsont.Error.to_string err)

     

       21
       21
       -
         | Session_error msg ->

     

       22
       22
       -
             Format.fprintf fmt "Session error: %s" msg

     

       23
       23
       -
         | Connection_error msg ->

     

       24
       24
       -
             Format.fprintf fmt "Connection error: %s" msg

     

       25
       25
       -
       

     

       26
       26
       -
       let error_to_string err =

     

       27
       27
       -
         Format.asprintf "%a" pp_error err

     

       28
       28
       -
       

     

       29
       29
       -
       exception Jmap_client_error of error

     

       30
       30
       -
       

     

       31
       31
       -
       type t = {

     

       32
       32
       -
         mutable session : Jmap_proto.Session.t;

     

       33
       33
       -
         requests : Requests.t;

     

       34
       34
       -
         auth : Requests.Auth.t option;

     

       35
       35
       -
         session_url : string;

     

       36
       36
       -
       }

     

       37
       37
       -
       

     

       38
       38
       -
       let session t = t.session

     

       39
       39
       -
       let api_url t = Jmap_proto.Session.api_url t.session

     

       40
       40
       -
       let upload_url t = Jmap_proto.Session.upload_url t.session

     

       41
       41
       -
       let download_url t = Jmap_proto.Session.download_url t.session

     

       42
       42
       -
       

     

       43
       43
       -
       let create ?auth ~session requests =

     

       44
       44
       -
         let session_url = Jmap_proto.Session.api_url session in

     

       45
       45
       -
         { session; requests; auth; session_url }

     

       46
       46
       -
       

     

       47
       47
       -
       let fetch_session ?auth requests url =

     

       48
       48
       -
         try

     

       49
       49
       -
           let response =

     

       50
       50
       -
             match auth with

     

       51
       51
       -
             | Some a -> Requests.get requests ~auth:a url

     

       52
       52
       -
             | None -> Requests.get requests url

     

       53
       53
       -
           in

     

       54
       54
       -
           if not (Requests.Response.ok response) then

     

       55
       55
       -
             Error (Http_error (Requests.Response.status_code response,

     

       56
       56
       -
                                "Failed to fetch session"))

     

       57
       57
       -
           else

     

       58
       58
       -
             let body = Requests.Response.text response in

     

       59
       59
       -
             match Codec.decode_session body with

     

       60
       60
       -
             | Ok session -> Ok session

     

       61
       61
       -
             | Error e -> Error (Json_error e)

     

       62
       62
       -
         with

     

       63
       63
       -
         | Eio.Io (Requests.Error.E err, _) ->

     

       64
       64
       -
           Error (Connection_error (Requests.Error.to_string err))

     

       65
       65
       -
         | exn -> Error (Session_error (Printexc.to_string exn))

     

       66
       66
       -
       

     

       67
       67
       -
       let create_from_url ?auth requests url =

     

       68
       68
       -
         match fetch_session ?auth requests url with

     

       69
       69
       -
         | Ok session ->

     

       70
       70
       -
             Ok { session; requests; auth; session_url = url }

     

       71
       71
       -
         | Error e -> Error e

     

       72
       72
       -
       

     

       73
       73
       -
       let create_from_url_exn ?auth requests url =

     

       74
       74
       -
         match create_from_url ?auth requests url with

     

       75
       75
       -
         | Ok t -> t

     

       76
       76
       -
         | Error e -> raise (Jmap_client_error e)

     

       77
       77
       -
       

     

       78
       78
       -
       let refresh_session t =

     

       79
       79
       -
         match fetch_session ?auth:t.auth t.requests t.session_url with

     

       80
       80
       -
         | Ok session ->

     

       81
       81
       -
             t.session <- session;

     

       82
       82
       -
             Ok ()

     

       83
       83
       -
         | Error e -> Error e

     

       84
       84
       -
       

     

       85
       85
       -
       let refresh_session_exn t =

     

       86
       86
       -
         match refresh_session t with

     

       87
       87
       -
         | Ok () -> ()

     

       88
       88
       -
         | Error e -> raise (Jmap_client_error e)

     

       89
       89
       -
       

     

       90
       90
       -
       let request t req =

     

       91
       91
       -
         try

     

       92
       92
       -
           match Codec.encode_request req with

     

       93
       93
       -
           | Error e -> Error (Json_error e)

     

       94
       94
       -
           | Ok body_str ->

     

       95
       95
       -
               let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       96
       96
       -
               let url = api_url t in

     

       97
       97
       -
               let response =

     

       98
       98
       -
                 match t.auth with

     

       99
       99
       -
                 | Some auth -> Requests.post t.requests ~auth ~body url

     

       100
       100
       -
                 | None -> Requests.post t.requests ~body url

     

       101
       101
       -
               in

     

       102
       102
       -
               if not (Requests.Response.ok response) then

     

       103
       103
       -
                 Error (Http_error (Requests.Response.status_code response,

     

       104
       104
       -
                                    Requests.Response.text response))

     

       105
       105
       -
               else

     

       106
       106
       -
                 let response_body = Requests.Response.text response in

     

       107
       107
       -
                 match Codec.decode_response response_body with

     

       108
       108
       -
                 | Ok resp -> Ok resp

     

       109
       109
       -
                 | Error e -> Error (Json_error e)

     

       110
       110
       -
         with

     

       111
       111
       -
         | Eio.Io (Requests.Error.E err, _) ->

     

       112
       112
       -
           Error (Connection_error (Requests.Error.to_string err))

     

       113
       113
       -
         | exn -> Error (Connection_error (Printexc.to_string exn))

     

       114
       114
       -
       

     

       115
       115
       -
       let request_exn t req =

     

       116
       116
       -
         match request t req with

     

       117
       117
       -
         | Ok resp -> resp

     

       118
       118
       -
         | Error e -> raise (Jmap_client_error e)

     

       119
       119
       -
       

     

       120
       120
       -
       let expand_upload_url t ~account_id =

     

       121
       121
       -
         let template = upload_url t in

     

       122
       122
       -
         let account_id_str = Jmap_proto.Id.to_string account_id in

     

       123
       123
       -
         (* Simple template expansion for {accountId} *)

     

       124
       124
       -
         let re = Str.regexp "{accountId}" in

     

       125
       125
       -
         Str.global_replace re account_id_str template

     

       126
       126
       -
       

     

       127
       127
       -
       let upload t ~account_id ~content_type ~data =

     

       128
       128
       -
         try

     

       129
       129
       -
           let url = expand_upload_url t ~account_id in

     

       130
       130
       -
           let mime = Requests.Mime.of_string content_type in

     

       131
       131
       -
           let body = Requests.Body.of_string mime data in

     

       132
       132
       -
           let response =

     

       133
       133
       -
             match t.auth with

     

       134
       134
       -
             | Some auth -> Requests.post t.requests ~auth ~body url

     

       135
       135
       -
             | None -> Requests.post t.requests ~body url

     

       136
       136
       -
           in

     

       137
       137
       -
           if not (Requests.Response.ok response) then

     

       138
       138
       -
             Error (Http_error (Requests.Response.status_code response,

     

       139
       139
       -
                                Requests.Response.text response))

     

       140
       140
       -
           else

     

       141
       141
       -
             let response_body = Requests.Response.text response in

     

       142
       142
       -
             match Codec.decode_upload_response response_body with

     

       143
       143
       -
             | Ok upload_resp -> Ok upload_resp

     

       144
       144
       -
             | Error e -> Error (Json_error e)

     

       145
       145
       -
         with

     

       146
       146
       -
         | Eio.Io (Requests.Error.E err, _) ->

     

       147
       147
       -
           Error (Connection_error (Requests.Error.to_string err))

     

       148
       148
       -
         | exn -> Error (Connection_error (Printexc.to_string exn))

     

       149
       149
       -
       

     

       150
       150
       -
       let upload_exn t ~account_id ~content_type ~data =

     

       151
       151
       -
         match upload t ~account_id ~content_type ~data with

     

       152
       152
       -
         | Ok resp -> resp

     

       153
       153
       -
         | Error e -> raise (Jmap_client_error e)

     

       154
       154
       -
       

     

       155
       155
       -
       let expand_download_url t ~account_id ~blob_id ?name ?accept () =

     

       156
       156
       -
         let template = download_url t in

     

       157
       157
       -
         let account_id_str = Jmap_proto.Id.to_string account_id in

     

       158
       158
       -
         let blob_id_str = Jmap_proto.Id.to_string blob_id in

     

       159
       159
       -
         let name_str = Option.value name ~default:"download" in

     

       160
       160
       -
         let type_str = Option.value accept ~default:"application/octet-stream" in

     

       161
       161
       -
         (* Simple template expansion *)

     

       162
       162
       -
         template

     

       163
       163
       -
         |> Str.global_replace (Str.regexp "{accountId}") account_id_str

     

       164
       164
       -
         |> Str.global_replace (Str.regexp "{blobId}") blob_id_str

     

       165
       165
       -
         |> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode name_str)

     

       166
       166
       -
         |> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode type_str)

     

       167
       167
       -
       

     

       168
       168
       -
       let download t ~account_id ~blob_id ?name ?accept () =

     

       169
       169
       -
         try

     

       170
       170
       -
           let url = expand_download_url t ~account_id ~blob_id ?name ?accept () in

     

       171
       171
       -
           let response =

     

       172
       172
       -
             match t.auth with

     

       173
       173
       -
             | Some auth -> Requests.get t.requests ~auth url

     

       174
       174
       -
             | None -> Requests.get t.requests url

     

       175
       175
       -
           in

     

       176
       176
       -
           if not (Requests.Response.ok response) then

     

       177
       177
       -
             Error (Http_error (Requests.Response.status_code response,

     

       178
       178
       -
                                Requests.Response.text response))

     

       179
       179
       -
           else

     

       180
       180
       -
             Ok (Requests.Response.text response)

     

       181
       181
       -
         with

     

       182
       182
       -
         | Eio.Io (Requests.Error.E err, _) ->

     

       183
       183
       -
           Error (Connection_error (Requests.Error.to_string err))

     

       184
       184
       -
         | exn -> Error (Connection_error (Printexc.to_string exn))

     

       185
       185
       -
       

     

       186
       186
       -
       let download_exn t ~account_id ~blob_id ?name ?accept () =

     

       187
       187
       -
         match download t ~account_id ~blob_id ?name ?accept () with

     

       188
       188
       -
         | Ok data -> data

     

       189
       189
       -
         | Error e -> raise (Jmap_client_error e)

     

       190
       190
       -
       

     

       191
       191
       -
       (* Convenience builders *)

     

       192
       192
       -
       module Build = struct

     

       193
       193
       -
         open Jmap_proto

     

       194
       194
       -
       

     

       195
       195
       -
         let json_of_id id =

     

       196
       196
       -
           Jsont.String (Id.to_string id, Jsont.Meta.none)

     

       197
       197
       -
       

     

       198
       198
       -
         let json_of_id_list ids =

     

       199
       199
       -
           let items = List.map json_of_id ids in

     

       200
       200
       -
           Jsont.Array (items, Jsont.Meta.none)

     

       201
       201
       -
       

     

       202
       202
       -
         let json_of_string_list strs =

     

       203
       203
       -
           let items = List.map (fun s -> Jsont.String (s, Jsont.Meta.none)) strs in

     

       204
       204
       -
           Jsont.Array (items, Jsont.Meta.none)

     

       205
       205
       -
       

     

       206
       206
       -
         let json_of_int64 n =

     

       207
       207
       -
           Jsont.Number (Int64.to_float n, Jsont.Meta.none)

     

       208
       208
       -
       

     

       209
       209
       -
         let json_of_bool b =

     

       210
       210
       -
           Jsont.Bool (b, Jsont.Meta.none)

     

       211
       211
       -
       

     

       212
       212
       -
         let json_name s = (s, Jsont.Meta.none)

     

       213
       213
       -
       

     

       214
       214
       -
         let json_obj fields =

     

       215
       215
       -
           let fields' = List.map (fun (k, v) -> (json_name k, v)) fields in

     

       216
       216
       -
           Jsont.Object (fields', Jsont.Meta.none)

     

       217
       217
       -
       

     

       218
       218
       -
         let make_invocation ~name ~call_id args =

     

       219
       219
       -
           Invocation.create ~name ~arguments:(json_obj args) ~method_call_id:call_id

     

       220
       220
       -
       

     

       221
       221
       -
         let echo ~call_id data =

     

       222
       222
       -
           make_invocation ~name:"Core/echo" ~call_id

     

       223
       223
       -
             [ ("data", data) ]

     

       224
       224
       -
       

     

       225
       225
       -
         let mailbox_get ~call_id ~account_id ?ids ?properties () =

     

       226
       226
       -
           let args = [

     

       227
       227
       -
             ("accountId", json_of_id account_id);

     

       228
       228
       -
           ] in

     

       229
       229
       -
           let args = match ids with

     

       230
       230
       -
             | None -> args

     

       231
       231
       -
             | Some ids -> ("ids", json_of_id_list ids) :: args

     

       232
       232
       -
           in

     

       233
       233
       -
           let args = match properties with

     

       234
       234
       -
             | None -> args

     

       235
       235
       -
             | Some props -> ("properties", json_of_string_list props) :: args

     

       236
       236
       -
           in

     

       237
       237
       -
           make_invocation ~name:"Mailbox/get" ~call_id args

     

       238
       238
       -
       

     

       239
       239
       -
         let mailbox_changes ~call_id ~account_id ~since_state ?max_changes () =

     

       240
       240
       -
           let args = [

     

       241
       241
       -
             ("accountId", json_of_id account_id);

     

       242
       242
       -
             ("sinceState", Jsont.String (since_state, Jsont.Meta.none));

     

       243
       243
       -
           ] in

     

       244
       244
       -
           let args = match max_changes with

     

       245
       245
       -
             | None -> args

     

       246
       246
       -
             | Some n -> ("maxChanges", json_of_int64 n) :: args

     

       247
       247
       -
           in

     

       248
       248
       -
           make_invocation ~name:"Mailbox/changes" ~call_id args

     

       249
       249
       -
       

     

       250
       250
       -
         let encode_to_json jsont value =

     

       251
       251
       -
           match Jsont.Json.encode' jsont value with

     

       252
       252
       -
           | Ok j -> j

     

       253
       253
       -
           | Error _ -> json_obj []

     

       254
       254
       -
       

     

       255
       255
       -
         let encode_list_to_json jsont values =

     

       256
       256
       -
           match Jsont.Json.encode' (Jsont.list jsont) values with

     

       257
       257
       -
           | Ok j -> j

     

       258
       258
       -
           | Error _ -> Jsont.Array ([], Jsont.Meta.none)

     

       259
       259
       -
       

     

       260
       260
       -
         let mailbox_query ~call_id ~account_id ?filter ?sort ?position ?limit () =

     

       261
       261
       -
           let args = [

     

       262
       262
       -
             ("accountId", json_of_id account_id);

     

       263
       263
       -
           ] in

     

       264
       264
       -
           let args = match filter with

     

       265
       265
       -
             | None -> args

     

       266
       266
       -
             | Some f ->

     

       267
       267
       -
                 ("filter", encode_to_json Jmap_mail.Mail_filter.mailbox_filter_jsont f) :: args

     

       268
       268
       -
           in

     

       269
       269
       -
           let args = match sort with

     

       270
       270
       -
             | None -> args

     

       271
       271
       -
             | Some comparators ->

     

       272
       272
       -
                 ("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args

     

       273
       273
       -
           in

     

       274
       274
       -
           let args = match position with

     

       275
       275
       -
             | None -> args

     

       276
       276
       -
             | Some n -> ("position", json_of_int64 n) :: args

     

       277
       277
       -
           in

     

       278
       278
       -
           let args = match limit with

     

       279
       279
       -
             | None -> args

     

       280
       280
       -
             | Some n -> ("limit", json_of_int64 n) :: args

     

       281
       281
       -
           in

     

       282
       282
       -
           make_invocation ~name:"Mailbox/query" ~call_id args

     

       283
       283
       -
       

     

       284
       284
       -
         let email_get ~call_id ~account_id ?ids ?properties ?body_properties

     

       285
       285
       -
             ?fetch_text_body_values ?fetch_html_body_values ?fetch_all_body_values

     

       286
       286
       -
             ?max_body_value_bytes () =

     

       287
       287
       -
           let args = [

     

       288
       288
       -
             ("accountId", json_of_id account_id);

     

       289
       289
       -
           ] in

     

       290
       290
       -
           let args = match ids with

     

       291
       291
       -
             | None -> args

     

       292
       292
       -
             | Some ids -> ("ids", json_of_id_list ids) :: args

     

       293
       293
       -
           in

     

       294
       294
       -
           let args = match properties with

     

       295
       295
       -
             | None -> args

     

       296
       296
       -
             | Some props -> ("properties", json_of_string_list props) :: args

     

       297
       297
       -
           in

     

       298
       298
       -
           let args = match body_properties with

     

       299
       299
       -
             | None -> args

     

       300
       300
       -
             | Some props -> ("bodyProperties", json_of_string_list props) :: args

     

       301
       301
       -
           in

     

       302
       302
       -
           let args = match fetch_text_body_values with

     

       303
       303
       -
             | None -> args

     

       304
       304
       -
             | Some b -> ("fetchTextBodyValues", json_of_bool b) :: args

     

       305
       305
       -
           in

     

       306
       306
       -
           let args = match fetch_html_body_values with

     

       307
       307
       -
             | None -> args

     

       308
       308
       -
             | Some b -> ("fetchHTMLBodyValues", json_of_bool b) :: args

     

       309
       309
       -
           in

     

       310
       310
       -
           let args = match fetch_all_body_values with

     

       311
       311
       -
             | None -> args

     

       312
       312
       -
             | Some b -> ("fetchAllBodyValues", json_of_bool b) :: args

     

       313
       313
       -
           in

     

       314
       314
       -
           let args = match max_body_value_bytes with

     

       315
       315
       -
             | None -> args

     

       316
       316
       -
             | Some n -> ("maxBodyValueBytes", json_of_int64 n) :: args

     

       317
       317
       -
           in

     

       318
       318
       -
           make_invocation ~name:"Email/get" ~call_id args

     

       319
       319
       -
       

     

       320
       320
       -
         let email_changes ~call_id ~account_id ~since_state ?max_changes () =

     

       321
       321
       -
           let args = [

     

       322
       322
       -
             ("accountId", json_of_id account_id);

     

       323
       323
       -
             ("sinceState", Jsont.String (since_state, Jsont.Meta.none));

     

       324
       324
       -
           ] in

     

       325
       325
       -
           let args = match max_changes with

     

       326
       326
       -
             | None -> args

     

       327
       327
       -
             | Some n -> ("maxChanges", json_of_int64 n) :: args

     

       328
       328
       -
           in

     

       329
       329
       -
           make_invocation ~name:"Email/changes" ~call_id args

     

       330
       330
       -
       

     

       331
       331
       -
         let email_query ~call_id ~account_id ?filter ?sort ?position ?limit

     

       332
       332
       -
             ?collapse_threads () =

     

       333
       333
       -
           let args = [

     

       334
       334
       -
             ("accountId", json_of_id account_id);

     

       335
       335
       -
           ] in

     

       336
       336
       -
           let args = match filter with

     

       337
       337
       -
             | None -> args

     

       338
       338
       -
             | Some f ->

     

       339
       339
       -
                 ("filter", encode_to_json Jmap_mail.Mail_filter.email_filter_jsont f) :: args

     

       340
       340
       -
           in

     

       341
       341
       -
           let args = match sort with

     

       342
       342
       -
             | None -> args

     

       343
       343
       -
             | Some comparators ->

     

       344
       344
       -
                 ("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args

     

       345
       345
       -
           in

     

       346
       346
       -
           let args = match position with

     

       347
       347
       -
             | None -> args

     

       348
       348
       -
             | Some n -> ("position", json_of_int64 n) :: args

     

       349
       349
       -
           in

     

       350
       350
       -
           let args = match limit with

     

       351
       351
       -
             | None -> args

     

       352
       352
       -
             | Some n -> ("limit", json_of_int64 n) :: args

     

       353
       353
       -
           in

     

       354
       354
       -
           let args = match collapse_threads with

     

       355
       355
       -
             | None -> args

     

       356
       356
       -
             | Some b -> ("collapseThreads", json_of_bool b) :: args

     

       357
       357
       -
           in

     

       358
       358
       -
           make_invocation ~name:"Email/query" ~call_id args

     

       359
       359
       -
       

     

       360
       360
       -
         let thread_get ~call_id ~account_id ?ids () =

     

       361
       361
       -
           let args = [

     

       362
       362
       -
             ("accountId", json_of_id account_id);

     

       363
       363
       -
           ] in

     

       364
       364
       -
           let args = match ids with

     

       365
       365
       -
             | None -> args

     

       366
       366
       -
             | Some ids -> ("ids", json_of_id_list ids) :: args

     

       367
       367
       -
           in

     

       368
       368
       -
           make_invocation ~name:"Thread/get" ~call_id args

     

       369
       369
       -
       

     

       370
       370
       -
         let thread_changes ~call_id ~account_id ~since_state ?max_changes () =

     

       371
       371
       -
           let args = [

     

       372
       372
       -
             ("accountId", json_of_id account_id);

     

       373
       373
       -
             ("sinceState", Jsont.String (since_state, Jsont.Meta.none));

     

       374
       374
       -
           ] in

     

       375
       375
       -
           let args = match max_changes with

     

       376
       376
       -
             | None -> args

     

       377
       377
       -
             | Some n -> ("maxChanges", json_of_int64 n) :: args

     

       378
       378
       -
           in

     

       379
       379
       -
           make_invocation ~name:"Thread/changes" ~call_id args

     

       380
       380
       -
       

     

       381
       381
       -
         let identity_get ~call_id ~account_id ?ids ?properties () =

     

       382
       382
       -
           let args = [

     

       383
       383
       -
             ("accountId", json_of_id account_id);

     

       384
       384
       -
           ] in

     

       385
       385
       -
           let args = match ids with

     

       386
       386
       -
             | None -> args

     

       387
       387
       -
             | Some ids -> ("ids", json_of_id_list ids) :: args

     

       388
       388
       -
           in

     

       389
       389
       -
           let args = match properties with

     

       390
       390
       -
             | None -> args

     

       391
       391
       -
             | Some props -> ("properties", json_of_string_list props) :: args

     

       392
       392
       -
           in

     

       393
       393
       -
           make_invocation ~name:"Identity/get" ~call_id args

     

       394
       394
       -
       

     

       395
       395
       -
         let email_submission_get ~call_id ~account_id ?ids ?properties () =

     

       396
       396
       -
           let args = [

     

       397
       397
       -
             ("accountId", json_of_id account_id);

     

       398
       398
       -
           ] in

     

       399
       399
       -
           let args = match ids with

     

       400
       400
       -
             | None -> args

     

       401
       401
       -
             | Some ids -> ("ids", json_of_id_list ids) :: args

     

       402
       402
       -
           in

     

       403
       403
       -
           let args = match properties with

     

       404
       404
       -
             | None -> args

     

       405
       405
       -
             | Some props -> ("properties", json_of_string_list props) :: args

     

       406
       406
       -
           in

     

       407
       407
       -
           make_invocation ~name:"EmailSubmission/get" ~call_id args

     

       408
       408
       -
       

     

       409
       409
       -
         let email_submission_query ~call_id ~account_id ?filter ?sort ?position ?limit () =

     

       410
       410
       -
           let args = [

     

       411
       411
       -
             ("accountId", json_of_id account_id);

     

       412
       412
       -
           ] in

     

       413
       413
       -
           let args = match filter with

     

       414
       414
       -
             | None -> args

     

       415
       415
       -
             | Some f ->

     

       416
       416
       -
                 ("filter", encode_to_json Jmap_mail.Mail_filter.submission_filter_jsont f) :: args

     

       417
       417
       -
           in

     

       418
       418
       -
           let args = match sort with

     

       419
       419
       -
             | None -> args

     

       420
       420
       -
             | Some comparators ->

     

       421
       421
       -
                 ("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args

     

       422
       422
       -
           in

     

       423
       423
       -
           let args = match position with

     

       424
       424
       -
             | None -> args

     

       425
       425
       -
             | Some n -> ("position", json_of_int64 n) :: args

     

       426
       426
       -
           in

     

       427
       427
       -
           let args = match limit with

     

       428
       428
       -
             | None -> args

     

       429
       429
       -
             | Some n -> ("limit", json_of_int64 n) :: args

     

       430
       430
       -
           in

     

       431
       431
       -
           make_invocation ~name:"EmailSubmission/query" ~call_id args

     

       432
       432
       -
       

     

       433
       433
       -
         let vacation_response_get ~call_id ~account_id () =

     

       434
       434
       -
           let args = [

     

       435
       435
       -
             ("accountId", json_of_id account_id);

     

       436
       436
       -
             ("ids", json_of_id_list [Jmap_mail.Vacation.singleton_id]);

     

       437
       437
       -
           ] in

     

       438
       438
       -
           make_invocation ~name:"VacationResponse/get" ~call_id args

     

       439
       439
       -
       

     

       440
       440
       -
         let make_request ?created_ids ~capabilities invocations =

     

       441
       441
       -
           Request.create

     

       442
       442
       -
             ~using:capabilities

     

       443
       443
       -
             ~method_calls:invocations

     

       444
       444
       -
             ?created_ids

     

       445
       445
       -
             ()

     

       446
       446
       -
       end

     

       447
       447
       -
       

     

       448
       448
       -
       (* Response parsing helpers *)

     

       449
       449
       -
       module Parse = struct

     

       450
       450
       -
         open Jmap_proto

     

       451
       451
       -
       

     

       452
       452
       -
         let decode_from_json jsont json =

     

       453
       453
       -
           Jsont.Json.decode' jsont json

     

       454
       454
       -
       

     

       455
       455
       -
         let find_invocation ~call_id response =

     

       456
       456
       -
           List.find_opt

     

       457
       457
       -
             (fun inv -> Invocation.method_call_id inv = call_id)

     

       458
       458
       -
             (Response.method_responses response)

     

       459
       459
       -
       

     

       460
       460
       -
         let get_invocation_exn ~call_id response =

     

       461
       461
       -
           match find_invocation ~call_id response with

     

       462
       462
       -
           | Some inv -> inv

     

       463
       463
       -
           | None -> failwith ("No invocation found with call_id: " ^ call_id)

     

       464
       464
       -
       

     

       465
       465
       -
         let parse_invocation jsont inv =

     

       466
       466
       -
           decode_from_json jsont (Invocation.arguments inv)

     

       467
       467
       -
       

     

       468
       468
       -
         let parse_response ~call_id jsont response =

     

       469
       469
       -
           let inv = get_invocation_exn ~call_id response in

     

       470
       470
       -
           parse_invocation jsont inv

     

       471
       471
       -
       

     

       472
       472
       -
         (* Typed response parsers *)

     

       473
       473
       -
       

     

       474
       474
       -
         let get_response obj_jsont =

     

       475
       475
       -
           Method.get_response_jsont obj_jsont

     

       476
       476
       -
       

     

       477
       477
       -
         let query_response = Method.query_response_jsont

     

       478
       478
       -
       

     

       479
       479
       -
         let changes_response = Method.changes_response_jsont

     

       480
       480
       -
       

     

       481
       481
       -
         let set_response obj_jsont =

     

       482
       482
       -
           Method.set_response_jsont obj_jsont

     

       483
       483
       -
       

     

       484
       484
       -
         (* Mail-specific parsers *)

     

       485
       485
       -
       

     

       486
       486
       -
         let mailbox_get_response =

     

       487
       487
       -
           get_response Jmap_mail.Mailbox.jsont

     

       488
       488
       -
       

     

       489
       489
       -
         let email_get_response =

     

       490
       490
       -
           get_response Jmap_mail.Email.jsont

     

       491
       491
       -
       

     

       492
       492
       -
         let thread_get_response =

     

       493
       493
       -
           get_response Jmap_mail.Thread.jsont

     

       494
       494
       -
       

     

       495
       495
       -
         let identity_get_response =

     

       496
       496
       -
           get_response Jmap_mail.Identity.jsont

     

       497
       497
       -
       

     

       498
       498
       -
         (* Convenience functions *)

     

       499
       499
       -
       

     

       500
       500
       -
         let parse_mailbox_get ~call_id response =

     

       501
       501
       -
           parse_response ~call_id mailbox_get_response response

     

       502
       502
       -
       

     

       503
       503
       -
         let parse_email_get ~call_id response =

     

       504
       504
       -
           parse_response ~call_id email_get_response response

     

       505
       505
       -
       

     

       506
       506
       -
         let parse_email_query ~call_id response =

     

       507
       507
       -
           parse_response ~call_id query_response response

     

       508
       508
       -
       

     

       509
       509
       -
         let parse_thread_get ~call_id response =

     

       510
       510
       -
           parse_response ~call_id thread_get_response response

     

       511
       511
       -
       

     

       512
       512
       -
         let parse_changes ~call_id response =

     

       513
       513
       -
           parse_response ~call_id changes_response response

     

       514
       514
       -
       end

-404

eio/client.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** High-level JMAP client using Requests

     

       7
       7
       -
       

     

       8
       8
       -
           This module provides a full-featured JMAP client with session management,

     

       9
       9
       -
           request execution, and blob upload/download capabilities. *)

     

       10
       10
       -
       

     

       11
       11
       -
       (** {1 Types} *)

     

       12
       12
       -
       

     

       13
       13
       -
       type t

     

       14
       14
       -
       (** A JMAP client with session state and HTTP connection management. *)

     

       15
       15
       -
       

     

       16
       16
       -
       type error =

     

       17
       17
       -
         | Http_error of int * string

     

       18
       18
       -
             (** HTTP error with status code and message. *)

     

       19
       19
       -
         | Jmap_error of Jmap_proto.Error.Request_error.t

     

       20
       20
       -
             (** JMAP protocol error at request level. *)

     

       21
       21
       -
         | Json_error of Jsont.Error.t

     

       22
       22
       -
             (** JSON encoding/decoding error. *)

     

       23
       23
       -
         | Session_error of string

     

       24
       24
       -
             (** Session fetch or parse error. *)

     

       25
       25
       -
         | Connection_error of string

     

       26
       26
       -
             (** Network connection error. *)

     

       27
       27
       -
       (** Error types that can occur during JMAP operations. *)

     

       28
       28
       -
       

     

       29
       29
       -
       val pp_error : Format.formatter -> error -> unit

     

       30
       30
       -
       (** Pretty-print an error. *)

     

       31
       31
       -
       

     

       32
       32
       -
       val error_to_string : error -> string

     

       33
       33
       -
       (** Convert an error to a string. *)

     

       34
       34
       -
       

     

       35
       35
       -
       exception Jmap_client_error of error

     

       36
       36
       -
       (** Exception wrapper for JMAP client errors. *)

     

       37
       37
       -
       

     

       38
       38
       -
       (** {1 Client Creation} *)

     

       39
       39
       -
       

     

       40
       40
       -
       val create :

     

       41
       41
       -
         ?auth:Requests.Auth.t ->

     

       42
       42
       -
         session:Jmap_proto.Session.t ->

     

       43
       43
       -
         Requests.t ->

     

       44
       44
       -
         t

     

       45
       45
       -
       (** [create ?auth ~session requests] creates a JMAP client from an existing

     

       46
       46
       -
           session and Requests instance.

     

       47
       47
       -
       

     

       48
       48
       -
           @param auth Authentication to use for requests.

     

       49
       49
       -
           @param session A pre-fetched JMAP session.

     

       50
       50
       -
           @param requests The Requests instance for HTTP operations. *)

     

       51
       51
       -
       

     

       52
       52
       -
       val create_from_url :

     

       53
       53
       -
         ?auth:Requests.Auth.t ->

     

       54
       54
       -
         Requests.t ->

     

       55
       55
       -
         string ->

     

       56
       56
       -
         (t, error) result

     

       57
       57
       -
       (** [create_from_url ?auth requests url] creates a JMAP client by fetching

     

       58
       58
       -
           the session from the given JMAP API URL or well-known URL.

     

       59
       59
       -
       

     

       60
       60
       -
           The URL can be either:

     

       61
       61
       -
           - A direct JMAP API URL (e.g., "https://api.example.com/jmap/")

     

       62
       62
       -
           - A well-known URL (e.g., "https://example.com/.well-known/jmap")

     

       63
       63
       -
       

     

       64
       64
       -
           @param auth Authentication to use for the session request and subsequent requests.

     

       65
       65
       -
           @param requests The Requests instance for HTTP operations.

     

       66
       66
       -
           @param url The JMAP API or well-known URL. *)

     

       67
       67
       -
       

     

       68
       68
       -
       val create_from_url_exn :

     

       69
       69
       -
         ?auth:Requests.Auth.t ->

     

       70
       70
       -
         Requests.t ->

     

       71
       71
       -
         string ->

     

       72
       72
       -
         t

     

       73
       73
       -
       (** [create_from_url_exn ?auth requests url] is like {!create_from_url} but

     

       74
       74
       -
           raises {!Jmap_client_error} on failure. *)

     

       75
       75
       -
       

     

       76
       76
       -
       (** {1 Session Access} *)

     

       77
       77
       -
       

     

       78
       78
       -
       val session : t -> Jmap_proto.Session.t

     

       79
       79
       -
       (** [session client] returns the current JMAP session. *)

     

       80
       80
       -
       

     

       81
       81
       -
       val refresh_session : t -> (unit, error) result

     

       82
       82
       -
       (** [refresh_session client] fetches a fresh session from the server and

     

       83
       83
       -
           updates the client's session state. *)

     

       84
       84
       -
       

     

       85
       85
       -
       val refresh_session_exn : t -> unit

     

       86
       86
       -
       (** [refresh_session_exn client] is like {!refresh_session} but raises on error. *)

     

       87
       87
       -
       

     

       88
       88
       -
       val api_url : t -> string

     

       89
       89
       -
       (** [api_url client] returns the JMAP API URL for this client. *)

     

       90
       90
       -
       

     

       91
       91
       -
       val upload_url : t -> string

     

       92
       92
       -
       (** [upload_url client] returns the blob upload URL template. *)

     

       93
       93
       -
       

     

       94
       94
       -
       val download_url : t -> string

     

       95
       95
       -
       (** [download_url client] returns the blob download URL template. *)

     

       96
       96
       -
       

     

       97
       97
       -
       (** {1 Request Execution} *)

     

       98
       98
       -
       

     

       99
       99
       -
       val request :

     

       100
       100
       -
         t ->

     

       101
       101
       -
         Jmap_proto.Request.t ->

     

       102
       102
       -
         (Jmap_proto.Response.t, error) result

     

       103
       103
       -
       (** [request client req] executes a JMAP request and returns the response. *)

     

       104
       104
       -
       

     

       105
       105
       -
       val request_exn :

     

       106
       106
       -
         t ->

     

       107
       107
       -
         Jmap_proto.Request.t ->

     

       108
       108
       -
         Jmap_proto.Response.t

     

       109
       109
       -
       (** [request_exn client req] is like {!request} but raises on error. *)

     

       110
       110
       -
       

     

       111
       111
       -
       (** {1 Blob Operations} *)

     

       112
       112
       -
       

     

       113
       113
       -
       val upload :

     

       114
       114
       -
         t ->

     

       115
       115
       -
         account_id:Jmap_proto.Id.t ->

     

       116
       116
       -
         content_type:string ->

     

       117
       117
       -
         data:string ->

     

       118
       118
       -
         (Jmap_proto.Blob.upload_response, error) result

     

       119
       119
       -
       (** [upload client ~account_id ~content_type ~data] uploads a blob.

     

       120
       120
       -
       

     

       121
       121
       -
           @param account_id The account to upload to.

     

       122
       122
       -
           @param content_type MIME type of the blob.

     

       123
       123
       -
           @param data The blob data as a string. *)

     

       124
       124
       -
       

     

       125
       125
       -
       val upload_exn :

     

       126
       126
       -
         t ->

     

       127
       127
       -
         account_id:Jmap_proto.Id.t ->

     

       128
       128
       -
         content_type:string ->

     

       129
       129
       -
         data:string ->

     

       130
       130
       -
         Jmap_proto.Blob.upload_response

     

       131
       131
       -
       (** [upload_exn client ~account_id ~content_type ~data] is like {!upload}

     

       132
       132
       -
           but raises on error. *)

     

       133
       133
       -
       

     

       134
       134
       -
       val download :

     

       135
       135
       -
         t ->

     

       136
       136
       -
         account_id:Jmap_proto.Id.t ->

     

       137
       137
       -
         blob_id:Jmap_proto.Id.t ->

     

       138
       138
       -
         ?name:string ->

     

       139
       139
       -
         ?accept:string ->

     

       140
       140
       -
         unit ->

     

       141
       141
       -
         (string, error) result

     

       142
       142
       -
       (** [download client ~account_id ~blob_id ?name ?accept ()] downloads a blob.

     

       143
       143
       -
       

     

       144
       144
       -
           @param account_id The account containing the blob.

     

       145
       145
       -
           @param blob_id The blob ID to download.

     

       146
       146
       -
           @param name Optional filename hint for Content-Disposition.

     

       147
       147
       -
           @param accept Optional Accept header value. *)

     

       148
       148
       -
       

     

       149
       149
       -
       val download_exn :

     

       150
       150
       -
         t ->

     

       151
       151
       -
         account_id:Jmap_proto.Id.t ->

     

       152
       152
       -
         blob_id:Jmap_proto.Id.t ->

     

       153
       153
       -
         ?name:string ->

     

       154
       154
       -
         ?accept:string ->

     

       155
       155
       -
         unit ->

     

       156
       156
       -
         string

     

       157
       157
       -
       (** [download_exn] is like {!download} but raises on error. *)

     

       158
       158
       -
       

     

       159
       159
       -
       (** {1 Convenience Builders}

     

       160
       160
       -
       

     

       161
       161
       -
           Helper functions for building common JMAP method invocations. *)

     

       162
       162
       -
       

     

       163
       163
       -
       module Build : sig

     

       164
       164
       -
         (** {2 Core Methods} *)

     

       165
       165
       -
       

     

       166
       166
       -
         val echo :

     

       167
       167
       -
           call_id:string ->

     

       168
       168
       -
           Jsont.json ->

     

       169
       169
       -
           Jmap_proto.Invocation.t

     

       170
       170
       -
         (** [echo ~call_id data] builds a Core/echo invocation. *)

     

       171
       171
       -
       

     

       172
       172
       -
         (** {2 Mailbox Methods} *)

     

       173
       173
       -
       

     

       174
       174
       -
         val mailbox_get :

     

       175
       175
       -
           call_id:string ->

     

       176
       176
       -
           account_id:Jmap_proto.Id.t ->

     

       177
       177
       -
           ?ids:Jmap_proto.Id.t list ->

     

       178
       178
       -
           ?properties:string list ->

     

       179
       179
       -
           unit ->

     

       180
       180
       -
           Jmap_proto.Invocation.t

     

       181
       181
       -
         (** [mailbox_get ~call_id ~account_id ?ids ?properties ()] builds a

     

       182
       182
       -
             Mailbox/get invocation. *)

     

       183
       183
       -
       

     

       184
       184
       -
         val mailbox_changes :

     

       185
       185
       -
           call_id:string ->

     

       186
       186
       -
           account_id:Jmap_proto.Id.t ->

     

       187
       187
       -
           since_state:string ->

     

       188
       188
       -
           ?max_changes:int64 ->

     

       189
       189
       -
           unit ->

     

       190
       190
       -
           Jmap_proto.Invocation.t

     

       191
       191
       -
         (** [mailbox_changes ~call_id ~account_id ~since_state ?max_changes ()]

     

       192
       192
       -
             builds a Mailbox/changes invocation. *)

     

       193
       193
       -
       

     

       194
       194
       -
         val mailbox_query :

     

       195
       195
       -
           call_id:string ->

     

       196
       196
       -
           account_id:Jmap_proto.Id.t ->

     

       197
       197
       -
           ?filter:Jmap_mail.Mail_filter.mailbox_filter ->

     

       198
       198
       -
           ?sort:Jmap_proto.Filter.comparator list ->

     

       199
       199
       -
           ?position:int64 ->

     

       200
       200
       -
           ?limit:int64 ->

     

       201
       201
       -
           unit ->

     

       202
       202
       -
           Jmap_proto.Invocation.t

     

       203
       203
       -
         (** [mailbox_query ~call_id ~account_id ?filter ?sort ?position ?limit ()]

     

       204
       204
       -
             builds a Mailbox/query invocation. *)

     

       205
       205
       -
       

     

       206
       206
       -
         (** {2 Email Methods} *)

     

       207
       207
       -
       

     

       208
       208
       -
         val email_get :

     

       209
       209
       -
           call_id:string ->

     

       210
       210
       -
           account_id:Jmap_proto.Id.t ->

     

       211
       211
       -
           ?ids:Jmap_proto.Id.t list ->

     

       212
       212
       -
           ?properties:string list ->

     

       213
       213
       -
           ?body_properties:string list ->

     

       214
       214
       -
           ?fetch_text_body_values:bool ->

     

       215
       215
       -
           ?fetch_html_body_values:bool ->

     

       216
       216
       -
           ?fetch_all_body_values:bool ->

     

       217
       217
       -
           ?max_body_value_bytes:int64 ->

     

       218
       218
       -
           unit ->

     

       219
       219
       -
           Jmap_proto.Invocation.t

     

       220
       220
       -
         (** [email_get ~call_id ~account_id ?ids ?properties ...] builds an

     

       221
       221
       -
             Email/get invocation. *)

     

       222
       222
       -
       

     

       223
       223
       -
         val email_changes :

     

       224
       224
       -
           call_id:string ->

     

       225
       225
       -
           account_id:Jmap_proto.Id.t ->

     

       226
       226
       -
           since_state:string ->

     

       227
       227
       -
           ?max_changes:int64 ->

     

       228
       228
       -
           unit ->

     

       229
       229
       -
           Jmap_proto.Invocation.t

     

       230
       230
       -
         (** [email_changes ~call_id ~account_id ~since_state ?max_changes ()]

     

       231
       231
       -
             builds an Email/changes invocation. *)

     

       232
       232
       -
       

     

       233
       233
       -
         val email_query :

     

       234
       234
       -
           call_id:string ->

     

       235
       235
       -
           account_id:Jmap_proto.Id.t ->

     

       236
       236
       -
           ?filter:Jmap_mail.Mail_filter.email_filter ->

     

       237
       237
       -
           ?sort:Jmap_proto.Filter.comparator list ->

     

       238
       238
       -
           ?position:int64 ->

     

       239
       239
       -
           ?limit:int64 ->

     

       240
       240
       -
           ?collapse_threads:bool ->

     

       241
       241
       -
           unit ->

     

       242
       242
       -
           Jmap_proto.Invocation.t

     

       243
       243
       -
         (** [email_query ~call_id ~account_id ?filter ?sort ?position ?limit

     

       244
       244
       -
             ?collapse_threads ()] builds an Email/query invocation. *)

     

       245
       245
       -
       

     

       246
       246
       -
         (** {2 Thread Methods} *)

     

       247
       247
       -
       

     

       248
       248
       -
         val thread_get :

     

       249
       249
       -
           call_id:string ->

     

       250
       250
       -
           account_id:Jmap_proto.Id.t ->

     

       251
       251
       -
           ?ids:Jmap_proto.Id.t list ->

     

       252
       252
       -
           unit ->

     

       253
       253
       -
           Jmap_proto.Invocation.t

     

       254
       254
       -
         (** [thread_get ~call_id ~account_id ?ids ()] builds a Thread/get invocation. *)

     

       255
       255
       -
       

     

       256
       256
       -
         val thread_changes :

     

       257
       257
       -
           call_id:string ->

     

       258
       258
       -
           account_id:Jmap_proto.Id.t ->

     

       259
       259
       -
           since_state:string ->

     

       260
       260
       -
           ?max_changes:int64 ->

     

       261
       261
       -
           unit ->

     

       262
       262
       -
           Jmap_proto.Invocation.t

     

       263
       263
       -
         (** [thread_changes ~call_id ~account_id ~since_state ?max_changes ()]

     

       264
       264
       -
             builds a Thread/changes invocation. *)

     

       265
       265
       -
       

     

       266
       266
       -
         (** {2 Identity Methods} *)

     

       267
       267
       -
       

     

       268
       268
       -
         val identity_get :

     

       269
       269
       -
           call_id:string ->

     

       270
       270
       -
           account_id:Jmap_proto.Id.t ->

     

       271
       271
       -
           ?ids:Jmap_proto.Id.t list ->

     

       272
       272
       -
           ?properties:string list ->

     

       273
       273
       -
           unit ->

     

       274
       274
       -
           Jmap_proto.Invocation.t

     

       275
       275
       -
         (** [identity_get ~call_id ~account_id ?ids ?properties ()] builds an

     

       276
       276
       -
             Identity/get invocation. *)

     

       277
       277
       -
       

     

       278
       278
       -
         (** {2 Submission Methods} *)

     

       279
       279
       -
       

     

       280
       280
       -
         val email_submission_get :

     

       281
       281
       -
           call_id:string ->

     

       282
       282
       -
           account_id:Jmap_proto.Id.t ->

     

       283
       283
       -
           ?ids:Jmap_proto.Id.t list ->

     

       284
       284
       -
           ?properties:string list ->

     

       285
       285
       -
           unit ->

     

       286
       286
       -
           Jmap_proto.Invocation.t

     

       287
       287
       -
         (** [email_submission_get ~call_id ~account_id ?ids ?properties ()]

     

       288
       288
       -
             builds an EmailSubmission/get invocation. *)

     

       289
       289
       -
       

     

       290
       290
       -
         val email_submission_query :

     

       291
       291
       -
           call_id:string ->

     

       292
       292
       -
           account_id:Jmap_proto.Id.t ->

     

       293
       293
       -
           ?filter:Jmap_mail.Mail_filter.submission_filter ->

     

       294
       294
       -
           ?sort:Jmap_proto.Filter.comparator list ->

     

       295
       295
       -
           ?position:int64 ->

     

       296
       296
       -
           ?limit:int64 ->

     

       297
       297
       -
           unit ->

     

       298
       298
       -
           Jmap_proto.Invocation.t

     

       299
       299
       -
         (** [email_submission_query ~call_id ~account_id ?filter ?sort ?position

     

       300
       300
       -
             ?limit ()] builds an EmailSubmission/query invocation. *)

     

       301
       301
       -
       

     

       302
       302
       -
         (** {2 Vacation Response Methods} *)

     

       303
       303
       -
       

     

       304
       304
       -
         val vacation_response_get :

     

       305
       305
       -
           call_id:string ->

     

       306
       306
       -
           account_id:Jmap_proto.Id.t ->

     

       307
       307
       -
           unit ->

     

       308
       308
       -
           Jmap_proto.Invocation.t

     

       309
       309
       -
         (** [vacation_response_get ~call_id ~account_id ()] builds a

     

       310
       310
       -
             VacationResponse/get invocation. The singleton ID is automatically used. *)

     

       311
       311
       -
       

     

       312
       312
       -
         (** {2 Request Building} *)

     

       313
       313
       -
       

     

       314
       314
       -
         val make_request :

     

       315
       315
       -
           ?created_ids:(Jmap_proto.Id.t * Jmap_proto.Id.t) list ->

     

       316
       316
       -
           capabilities:string list ->

     

       317
       317
       -
           Jmap_proto.Invocation.t list ->

     

       318
       318
       -
           Jmap_proto.Request.t

     

       319
       319
       -
         (** [make_request ?created_ids ~capabilities invocations] builds a JMAP request.

     

       320
       320
       -
       

     

       321
       321
       -
             @param created_ids Optional client-created ID mappings.

     

       322
       322
       -
             @param capabilities List of capability URIs to use.

     

       323
       323
       -
             @param invocations List of method invocations. *)

     

       324
       324
       -
       end

     

       325
       325
       -
       

     

       326
       326
       -
       (** {1 Response Parsing}

     

       327
       327
       -
       

     

       328
       328
       -
           Helper functions for parsing typed responses from JMAP invocations. *)

     

       329
       329
       -
       

     

       330
       330
       -
       module Parse : sig

     

       331
       331
       -
         val find_invocation :

     

       332
       332
       -
           call_id:string ->

     

       333
       333
       -
           Jmap_proto.Response.t ->

     

       334
       334
       -
           Jmap_proto.Invocation.t option

     

       335
       335
       -
         (** [find_invocation ~call_id response] finds an invocation by call ID. *)

     

       336
       336
       -
       

     

       337
       337
       -
         val get_invocation_exn :

     

       338
       338
       -
           call_id:string ->

     

       339
       339
       -
           Jmap_proto.Response.t ->

     

       340
       340
       -
           Jmap_proto.Invocation.t

     

       341
       341
       -
         (** [get_invocation_exn ~call_id response] finds an invocation by call ID.

     

       342
       342
       -
             @raise Failure if not found. *)

     

       343
       343
       -
       

     

       344
       344
       -
         val parse_invocation :

     

       345
       345
       -
           'a Jsont.t ->

     

       346
       346
       -
           Jmap_proto.Invocation.t ->

     

       347
       347
       -
           ('a, Jsont.Error.t) result

     

       348
       348
       -
         (** [parse_invocation jsont inv] decodes the invocation's arguments. *)

     

       349
       349
       -
       

     

       350
       350
       -
         val parse_response :

     

       351
       351
       -
           call_id:string ->

     

       352
       352
       -
           'a Jsont.t ->

     

       353
       353
       -
           Jmap_proto.Response.t ->

     

       354
       354
       -
           ('a, Jsont.Error.t) result

     

       355
       355
       -
         (** [parse_response ~call_id jsont response] finds and parses an invocation. *)

     

       356
       356
       -
       

     

       357
       357
       -
         (** {2 Typed Response Codecs} *)

     

       358
       358
       -
       

     

       359
       359
       -
         val get_response : 'a Jsont.t -> 'a Jmap_proto.Method.get_response Jsont.t

     

       360
       360
       -
         (** [get_response obj_jsont] creates a Foo/get response codec. *)

     

       361
       361
       -
       

     

       362
       362
       -
         val query_response : Jmap_proto.Method.query_response Jsont.t

     

       363
       363
       -
         (** Codec for Foo/query responses. *)

     

       364
       364
       -
       

     

       365
       365
       -
         val changes_response : Jmap_proto.Method.changes_response Jsont.t

     

       366
       366
       -
         (** Codec for Foo/changes responses. *)

     

       367
       367
       -
       

     

       368
       368
       -
         val set_response : 'a Jsont.t -> 'a Jmap_proto.Method.set_response Jsont.t

     

       369
       369
       -
         (** [set_response obj_jsont] creates a Foo/set response codec. *)

     

       370
       370
       -
       

     

       371
       371
       -
         (** {2 Mail-specific Codecs} *)

     

       372
       372
       -
       

     

       373
       373
       -
         val mailbox_get_response : Jmap_mail.Mailbox.t Jmap_proto.Method.get_response Jsont.t

     

       374
       374
       -
         val email_get_response : Jmap_mail.Email.t Jmap_proto.Method.get_response Jsont.t

     

       375
       375
       -
         val thread_get_response : Jmap_mail.Thread.t Jmap_proto.Method.get_response Jsont.t

     

       376
       376
       -
         val identity_get_response : Jmap_mail.Identity.t Jmap_proto.Method.get_response Jsont.t

     

       377
       377
       -
       

     

       378
       378
       -
         (** {2 Convenience Parsers} *)

     

       379
       379
       -
       

     

       380
       380
       -
         val parse_mailbox_get :

     

       381
       381
       -
           call_id:string ->

     

       382
       382
       -
           Jmap_proto.Response.t ->

     

       383
       383
       -
           (Jmap_mail.Mailbox.t Jmap_proto.Method.get_response, Jsont.Error.t) result

     

       384
       384
       -
       

     

       385
       385
       -
         val parse_email_get :

     

       386
       386
       -
           call_id:string ->

     

       387
       387
       -
           Jmap_proto.Response.t ->

     

       388
       388
       -
           (Jmap_mail.Email.t Jmap_proto.Method.get_response, Jsont.Error.t) result

     

       389
       389
       -
       

     

       390
       390
       -
         val parse_email_query :

     

       391
       391
       -
           call_id:string ->

     

       392
       392
       -
           Jmap_proto.Response.t ->

     

       393
       393
       -
           (Jmap_proto.Method.query_response, Jsont.Error.t) result

     

       394
       394
       -
       

     

       395
       395
       -
         val parse_thread_get :

     

       396
       396
       -
           call_id:string ->

     

       397
       397
       -
           Jmap_proto.Response.t ->

     

       398
       398
       -
           (Jmap_mail.Thread.t Jmap_proto.Method.get_response, Jsont.Error.t) result

     

       399
       399
       -
       

     

       400
       400
       -
         val parse_changes :

     

       401
       401
       -
           call_id:string ->

     

       402
       402
       -
           Jmap_proto.Response.t ->

     

       403
       403
       -
           (Jmap_proto.Method.changes_response, Jsont.Error.t) result

     

       404
       404
       -
       end

-42

eio/codec.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       let encode ?format jsont value =

     

       7
       7
       -
         Jsont_bytesrw.encode_string' ?format jsont value

     

       8
       8
       -
       

     

       9
       9
       -
       let decode ?locs jsont json =

     

       10
       10
       -
         Jsont_bytesrw.decode_string' ?locs jsont json

     

       11
       11
       -
       

     

       12
       12
       -
       let encode_request ?format request =

     

       13
       13
       -
         encode ?format Jmap_proto.Request.jsont request

     

       14
       14
       -
       

     

       15
       15
       -
       let encode_request_exn ?format request =

     

       16
       16
       -
         match encode_request ?format request with

     

       17
       17
       -
         | Ok s -> s

     

       18
       18
       -
         | Error e -> failwith (Jsont.Error.to_string e)

     

       19
       19
       -
       

     

       20
       20
       -
       let decode_response ?locs json =

     

       21
       21
       -
         decode ?locs Jmap_proto.Response.jsont json

     

       22
       22
       -
       

     

       23
       23
       -
       let decode_response_exn ?locs json =

     

       24
       24
       -
         match decode_response ?locs json with

     

       25
       25
       -
         | Ok r -> r

     

       26
       26
       -
         | Error e -> failwith (Jsont.Error.to_string e)

     

       27
       27
       -
       

     

       28
       28
       -
       let decode_session ?locs json =

     

       29
       29
       -
         decode ?locs Jmap_proto.Session.jsont json

     

       30
       30
       -
       

     

       31
       31
       -
       let decode_session_exn ?locs json =

     

       32
       32
       -
         match decode_session ?locs json with

     

       33
       33
       -
         | Ok s -> s

     

       34
       34
       -
         | Error e -> failwith (Jsont.Error.to_string e)

     

       35
       35
       -
       

     

       36
       36
       -
       let decode_upload_response ?locs json =

     

       37
       37
       -
         decode ?locs Jmap_proto.Blob.upload_response_jsont json

     

       38
       38
       -
       

     

       39
       39
       -
       let decode_upload_response_exn ?locs json =

     

       40
       40
       -
         match decode_upload_response ?locs json with

     

       41
       41
       -
         | Ok r -> r

     

       42
       42
       -
         | Error e -> failwith (Jsont.Error.to_string e)

-92

eio/codec.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP JSON codec for Eio

     

       7
       7
       -
       

     

       8
       8
       -
           Low-level encoding and decoding of JMAP messages using jsont and bytesrw. *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** {1 Request Encoding} *)

     

       11
       11
       -
       

     

       12
       12
       -
       val encode_request :

     

       13
       13
       -
         ?format:Jsont.format ->

     

       14
       14
       -
         Jmap_proto.Request.t ->

     

       15
       15
       -
         (string, Jsont.Error.t) result

     

       16
       16
       -
       (** [encode_request ?format request] encodes a JMAP request to a JSON string.

     

       17
       17
       -
       

     

       18
       18
       -
           @param format The JSON formatting style. Defaults to {!Jsont.Minify}. *)

     

       19
       19
       -
       

     

       20
       20
       -
       val encode_request_exn :

     

       21
       21
       -
         ?format:Jsont.format ->

     

       22
       22
       -
         Jmap_proto.Request.t ->

     

       23
       23
       -
         string

     

       24
       24
       -
       (** [encode_request_exn ?format request] is like {!encode_request} but raises

     

       25
       25
       -
           on encoding errors. *)

     

       26
       26
       -
       

     

       27
       27
       -
       (** {1 Response Decoding} *)

     

       28
       28
       -
       

     

       29
       29
       -
       val decode_response :

     

       30
       30
       -
         ?locs:bool ->

     

       31
       31
       -
         string ->

     

       32
       32
       -
         (Jmap_proto.Response.t, Jsont.Error.t) result

     

       33
       33
       -
       (** [decode_response ?locs json] decodes a JMAP response from a JSON string.

     

       34
       34
       -
       

     

       35
       35
       -
           @param locs If [true], location information is preserved for error messages.

     

       36
       36
       -
                       Defaults to [false]. *)

     

       37
       37
       -
       

     

       38
       38
       -
       val decode_response_exn :

     

       39
       39
       -
         ?locs:bool ->

     

       40
       40
       -
         string ->

     

       41
       41
       -
         Jmap_proto.Response.t

     

       42
       42
       -
       (** [decode_response_exn ?locs json] is like {!decode_response} but raises

     

       43
       43
       -
           on decoding errors. *)

     

       44
       44
       -
       

     

       45
       45
       -
       (** {1 Session Decoding} *)

     

       46
       46
       -
       

     

       47
       47
       -
       val decode_session :

     

       48
       48
       -
         ?locs:bool ->

     

       49
       49
       -
         string ->

     

       50
       50
       -
         (Jmap_proto.Session.t, Jsont.Error.t) result

     

       51
       51
       -
       (** [decode_session ?locs json] decodes a JMAP session from a JSON string.

     

       52
       52
       -
       

     

       53
       53
       -
           @param locs If [true], location information is preserved for error messages.

     

       54
       54
       -
                       Defaults to [false]. *)

     

       55
       55
       -
       

     

       56
       56
       -
       val decode_session_exn :

     

       57
       57
       -
         ?locs:bool ->

     

       58
       58
       -
         string ->

     

       59
       59
       -
         Jmap_proto.Session.t

     

       60
       60
       -
       (** [decode_session_exn ?locs json] is like {!decode_session} but raises

     

       61
       61
       -
           on decoding errors. *)

     

       62
       62
       -
       

     

       63
       63
       -
       (** {1 Blob Upload Response Decoding} *)

     

       64
       64
       -
       

     

       65
       65
       -
       val decode_upload_response :

     

       66
       66
       -
         ?locs:bool ->

     

       67
       67
       -
         string ->

     

       68
       68
       -
         (Jmap_proto.Blob.upload_response, Jsont.Error.t) result

     

       69
       69
       -
       (** [decode_upload_response ?locs json] decodes a blob upload response. *)

     

       70
       70
       -
       

     

       71
       71
       -
       val decode_upload_response_exn :

     

       72
       72
       -
         ?locs:bool ->

     

       73
       73
       -
         string ->

     

       74
       74
       -
         Jmap_proto.Blob.upload_response

     

       75
       75
       -
       (** [decode_upload_response_exn ?locs json] is like {!decode_upload_response}

     

       76
       76
       -
           but raises on decoding errors. *)

     

       77
       77
       -
       

     

       78
       78
       -
       (** {1 Generic Encoding/Decoding} *)

     

       79
       79
       -
       

     

       80
       80
       -
       val encode :

     

       81
       81
       -
         ?format:Jsont.format ->

     

       82
       82
       -
         'a Jsont.t ->

     

       83
       83
       -
         'a ->

     

       84
       84
       -
         (string, Jsont.Error.t) result

     

       85
       85
       -
       (** [encode ?format jsont value] encodes any value using its jsont codec. *)

     

       86
       86
       -
       

     

       87
       87
       -
       val decode :

     

       88
       88
       -
         ?locs:bool ->

     

       89
       89
       -
         'a Jsont.t ->

     

       90
       90
       -
         string ->

     

       91
       91
       -
         ('a, Jsont.Error.t) result

     

       92
       92
       -
       (** [decode ?locs jsont json] decodes any value using its jsont codec. *)

-5

eio/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name jmap_eio)

     

       3
       3
       -
        (public_name jmap-eio)

     

       4
       4
       -
        (libraries jmap jmap.mail jsont jsont.bytesrw eio requests uri str)

     

       5
       5
       -
        (modules jmap_eio codec client))

-7

eio/jmap_eio.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Codec = Codec

     

       7
       7
       -
       module Client = Client

-73

eio/jmap_eio.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP client library for Eio

     

       7
       7
       -
       

     

       8
       8
       -
           This library provides a complete JMAP (RFC 8620/8621) client implementation

     

       9
       9
       -
           for OCaml using Eio for effects-based concurrency and Requests for HTTP.

     

       10
       10
       -
       

     

       11
       11
       -
           {2 Overview}

     

       12
       12
       -
       

     

       13
       13
       -
           The library consists of two layers:

     

       14
       14
       -
       

     

       15
       15
       -
           - {!Codec}: Low-level JSON encoding/decoding for JMAP messages

     

       16
       16
       -
           - {!Client}: High-level JMAP client with session management

     

       17
       17
       -
       

     

       18
       18
       -
           {2 Quick Start}

     

       19
       19
       -
       

     

       20
       20
       -
           {[

     

       21
       21
       -
             open Eio_main

     

       22
       22
       -
       

     

       23
       23
       -
             let () = run @@ fun env ->

     

       24
       24
       -
               Eio.Switch.run @@ fun sw ->

     

       25
       25
       -
       

     

       26
       26
       -
               (* Create HTTP client *)

     

       27
       27
       -
               let requests = Requests.create ~sw env in

     

       28
       28
       -
       

     

       29
       29
       -
               (* Create JMAP client from well-known URL *)

     

       30
       30
       -
               let client = Jmap_eio.Client.create_from_url_exn

     

       31
       31
       -
                 ~auth:(Requests.Auth.bearer "your-token")

     

       32
       32
       -
                 requests

     

       33
       33
       -
                 "https://api.example.com/.well-known/jmap" in

     

       34
       34
       -
       

     

       35
       35
       -
               (* Get session info *)

     

       36
       36
       -
               let session = Jmap_eio.Client.session client in

     

       37
       37
       -
               Printf.printf "API URL: %s\n" (Jmap_proto.Session.api_url session);

     

       38
       38
       -
       

     

       39
       39
       -
               (* Build and execute a request *)

     

       40
       40
       -
               let account_id = (* get from session *) ... in

     

       41
       41
       -
               let req = Jmap_eio.Client.Build.(

     

       42
       42
       -
                 make_request

     

       43
       43
       -
                   ~capabilities:[Jmap_proto.Capability.core_uri;

     

       44
       44
       -
                                 Jmap_proto.Capability.mail_uri]

     

       45
       45
       -
                   [mailbox_get ~call_id:"0" ~account_id ()]

     

       46
       46
       -
               ) in

     

       47
       47
       -
               let response = Jmap_eio.Client.request_exn client req in

     

       48
       48
       -
       

     

       49
       49
       -
               (* Process response *)

     

       50
       50
       -
               List.iter (fun inv ->

     

       51
       51
       -
                 Printf.printf "Method: %s, CallId: %s\n"

     

       52
       52
       -
                   (Jmap_proto.Invocation.name inv)

     

       53
       53
       -
                   (Jmap_proto.Invocation.method_call_id inv)

     

       54
       54
       -
               ) (Jmap_proto.Response.method_responses response)

     

       55
       55
       -
           ]}

     

       56
       56
       -
       

     

       57
       57
       -
           {2 Capabilities}

     

       58
       58
       -
       

     

       59
       59
       -
           JMAP uses capability URIs to indicate supported features:

     

       60
       60
       -
       

     

       61
       61
       -
           - [urn:ietf:params:jmap:core] - Core JMAP

     

       62
       62
       -
           - [urn:ietf:params:jmap:mail] - Email, Mailbox, Thread

     

       63
       63
       -
           - [urn:ietf:params:jmap:submission] - EmailSubmission

     

       64
       64
       -
           - [urn:ietf:params:jmap:vacationresponse] - VacationResponse

     

       65
       65
       -
       

     

       66
       66
       -
           These are available as constants in {!Jmap_proto.Capability}.

     

       67
       67
       -
       *)

     

       68
       68
       -
       

     

       69
       69
       -
       (** Low-level JSON codec for JMAP messages. *)

     

       70
       70
       -
       module Codec = Codec

     

       71
       71
       -
       

     

       72
       72
       -
       (** High-level JMAP client with session management. *)

     

       73
       73
       -
       module Client = Client

+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

-35

jmap-eio.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "JMAP client for Eio"

     

       4
       4
       -
       description:

     

       5
       5
       -
         "High-level JMAP client using Eio for async I/O and the Requests HTTP library."

     

       6
       6
       -
       maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       7
       7
       -
       authors: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       8
       8
       -
       license: "ISC"

     

       9
       9
       -
       homepage: "https://github.com/avsm/ocaml-jmap"

     

       10
       10
       -
       doc: "https://avsm.github.io/ocaml-jmap"

     

       11
       11
       -
       bug-reports: "https://github.com/avsm/ocaml-jmap/issues"

     

       12
       12
       -
       depends: [

     

       13
       13
       -
         "dune" {>= "3.0"}

     

       14
       14
       -
         "ocaml" {>= "4.14.0"}

     

       15
       15
       -
         "jmap" {= version}

     

       16
       16
       -
         "jsont" {>= "0.2.0"}

     

       17
       17
       -
         "eio"

     

       18
       18
       -
         "requests"

     

       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/ocaml-jmap.git"

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

-33

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 implementation for OCaml"

     

       4
       4
       -
       description:

     

       5
       5
       -
         "A complete implementation of the JSON Meta Application Protocol (JMAP) as specified in RFC 8620 (core) and RFC 8621 (mail)."

     

       6
       6
       -
       maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       7
       7
       -
       authors: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       8
       8
       -
       license: "ISC"

     

       9
       9
       -
       homepage: "https://github.com/avsm/ocaml-jmap"

     

       10
       10
       -
       doc: "https://avsm.github.io/ocaml-jmap"

     

       11
       11
       -
       bug-reports: "https://github.com/avsm/ocaml-jmap/issues"

     

       12
       12
       -
       depends: [

     

       13
       13
       -
         "dune" {>= "3.0"}

     

       14
       14
       -
         "ocaml" {>= "4.14.0"}

     

       15
       15
       -
         "jsont" {>= "0.2.0"}

     

       16
       16
       -
         "ptime" {>= "1.0.0"}

     

       17
       17
       -
         "odoc" {with-doc}

     

       18
       18
       -
       ]

     

       19
       19
       -
       build: [

     

       20
       20
       -
         ["dune" "subst"] {dev}

     

       21
       21
       -
         [

     

       22
       22
       -
           "dune"

     

       23
       23
       -
           "build"

     

       24
       24
       -
           "-p"

     

       25
       25
       -
           name

     

       26
       26
       -
           "-j"

     

       27
       27
       -
           jobs

     

       28
       28
       -
           "@install"

     

       29
       29
       -
           "@runtest" {with-test}

     

       30
       30
       -
           "@doc" {with-doc}

     

       31
       31
       -
         ]

     

       32
       32
       -
       ]

     

       33
       33
       -
       dev-repo: "git+https://github.com/avsm/ocaml-jmap.git"

-105

proto/blob.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type upload_response = {

     

       7
       7
       -
         account_id : Id.t;

     

       8
       8
       -
         blob_id : Id.t;

     

       9
       9
       -
         type_ : string;

     

       10
       10
       -
         size : int64;

     

       11
       11
       -
       }

     

       12
       12
       -
       

     

       13
       13
       -
       let upload_response_account_id t = t.account_id

     

       14
       14
       -
       let upload_response_blob_id t = t.blob_id

     

       15
       15
       -
       let upload_response_type t = t.type_

     

       16
       16
       -
       let upload_response_size t = t.size

     

       17
       17
       -
       

     

       18
       18
       -
       let upload_response_make account_id blob_id type_ size =

     

       19
       19
       -
         { account_id; blob_id; type_; size }

     

       20
       20
       -
       

     

       21
       21
       -
       let upload_response_jsont =

     

       22
       22
       -
         let kind = "Upload response" in

     

       23
       23
       -
         Jsont.Object.map ~kind upload_response_make

     

       24
       24
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:upload_response_account_id

     

       25
       25
       -
         |> Jsont.Object.mem "blobId" Id.jsont ~enc:upload_response_blob_id

     

       26
       26
       -
         |> Jsont.Object.mem "type" Jsont.string ~enc:upload_response_type

     

       27
       27
       -
         |> Jsont.Object.mem "size" Int53.Unsigned.jsont ~enc:upload_response_size

     

       28
       28
       -
         |> Jsont.Object.finish

     

       29
       29
       -
       

     

       30
       30
       -
       type download_vars = {

     

       31
       31
       -
         account_id : Id.t;

     

       32
       32
       -
         blob_id : Id.t;

     

       33
       33
       -
         type_ : string;

     

       34
       34
       -
         name : string;

     

       35
       35
       -
       }

     

       36
       36
       -
       

     

       37
       37
       -
       let expand_download_url ~template vars =

     

       38
       38
       -
         let url_encode s =

     

       39
       39
       -
           (* Simple URL encoding *)

     

       40
       40
       -
           let buf = Buffer.create (String.length s * 3) in

     

       41
       41
       -
           String.iter (fun c ->

     

       42
       42
       -
             match c with

     

       43
       43
       -
             | 'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~' ->

     

       44
       44
       -
               Buffer.add_char buf c

     

       45
       45
       -
             | _ ->

     

       46
       46
       -
               Buffer.add_string buf (Printf.sprintf "%%%02X" (Char.code c))

     

       47
       47
       -
           ) s;

     

       48
       48
       -
           Buffer.contents buf

     

       49
       49
       -
         in

     

       50
       50
       -
         template

     

       51
       51
       -
         |> String.split_on_char '{'

     

       52
       52
       -
         |> List.mapi (fun i part ->

     

       53
       53
       -
           if i = 0 then part

     

       54
       54
       -
           else

     

       55
       55
       -
             match String.index_opt part '}' with

     

       56
       56
       -
             | None -> "{" ^ part

     

       57
       57
       -
             | Some j ->

     

       58
       58
       -
               let var = String.sub part 0 j in

     

       59
       59
       -
               let rest = String.sub part (j + 1) (String.length part - j - 1) in

     

       60
       60
       -
               let value = match var with

     

       61
       61
       -
                 | "accountId" -> url_encode (Id.to_string vars.account_id)

     

       62
       62
       -
                 | "blobId" -> url_encode (Id.to_string vars.blob_id)

     

       63
       63
       -
                 | "type" -> url_encode vars.type_

     

       64
       64
       -
                 | "name" -> url_encode vars.name

     

       65
       65
       -
                 | _ -> "{" ^ var ^ "}"

     

       66
       66
       -
               in

     

       67
       67
       -
               value ^ rest

     

       68
       68
       -
         )

     

       69
       69
       -
         |> String.concat ""

     

       70
       70
       -
       

     

       71
       71
       -
       type copy_args = {

     

       72
       72
       -
         from_account_id : Id.t;

     

       73
       73
       -
         account_id : Id.t;

     

       74
       74
       -
         blob_ids : Id.t list;

     

       75
       75
       -
       }

     

       76
       76
       -
       

     

       77
       77
       -
       let copy_args_make from_account_id account_id blob_ids =

     

       78
       78
       -
         { from_account_id; account_id; blob_ids }

     

       79
       79
       -
       

     

       80
       80
       -
       let copy_args_jsont =

     

       81
       81
       -
         let kind = "Blob/copy args" in

     

       82
       82
       -
         Jsont.Object.map ~kind copy_args_make

     

       83
       83
       -
         |> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun a -> a.from_account_id)

     

       84
       84
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       85
       85
       -
         |> Jsont.Object.mem "blobIds" (Jsont.list Id.jsont) ~enc:(fun a -> a.blob_ids)

     

       86
       86
       -
         |> Jsont.Object.finish

     

       87
       87
       -
       

     

       88
       88
       -
       type copy_response = {

     

       89
       89
       -
         from_account_id : Id.t;

     

       90
       90
       -
         account_id : Id.t;

     

       91
       91
       -
         copied : (Id.t * Id.t) list option;

     

       92
       92
       -
         not_copied : (Id.t * Error.set_error) list option;

     

       93
       93
       -
       }

     

       94
       94
       -
       

     

       95
       95
       -
       let copy_response_make from_account_id account_id copied not_copied =

     

       96
       96
       -
         { from_account_id; account_id; copied; not_copied }

     

       97
       97
       -
       

     

       98
       98
       -
       let copy_response_jsont =

     

       99
       99
       -
         let kind = "Blob/copy response" in

     

       100
       100
       -
         Jsont.Object.map ~kind copy_response_make

     

       101
       101
       -
         |> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun r -> r.from_account_id)

     

       102
       102
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       103
       103
       -
         |> Jsont.Object.opt_mem "copied" (Json_map.of_id Id.jsont) ~enc:(fun r -> r.copied)

     

       104
       104
       -
         |> Jsont.Object.opt_mem "notCopied" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_copied)

     

       105
       105
       -
         |> Jsont.Object.finish

-65

proto/blob.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP blob upload/download types as defined in RFC 8620 Section 6 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Upload Response} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Response from a blob upload. *)

     

       11
       11
       -
       type upload_response = {

     

       12
       12
       -
         account_id : Id.t;

     

       13
       13
       -
         (** The account the blob was uploaded to. *)

     

       14
       14
       -
         blob_id : Id.t;

     

       15
       15
       -
         (** The server-assigned blob id. *)

     

       16
       16
       -
         type_ : string;

     

       17
       17
       -
         (** The media type of the uploaded blob. *)

     

       18
       18
       -
         size : int64;

     

       19
       19
       -
         (** The size in octets. *)

     

       20
       20
       -
       }

     

       21
       21
       -
       

     

       22
       22
       -
       val upload_response_account_id : upload_response -> Id.t

     

       23
       23
       -
       val upload_response_blob_id : upload_response -> Id.t

     

       24
       24
       -
       val upload_response_type : upload_response -> string

     

       25
       25
       -
       val upload_response_size : upload_response -> int64

     

       26
       26
       -
       

     

       27
       27
       -
       val upload_response_jsont : upload_response Jsont.t

     

       28
       28
       -
       

     

       29
       29
       -
       (** {1 Download URL Template} *)

     

       30
       30
       -
       

     

       31
       31
       -
       (** Variables for the download URL template. *)

     

       32
       32
       -
       type download_vars = {

     

       33
       33
       -
         account_id : Id.t;

     

       34
       34
       -
         blob_id : Id.t;

     

       35
       35
       -
         type_ : string;

     

       36
       36
       -
         name : string;

     

       37
       37
       -
       }

     

       38
       38
       -
       

     

       39
       39
       -
       val expand_download_url : template:string -> download_vars -> string

     

       40
       40
       -
       (** [expand_download_url ~template vars] expands the download URL template

     

       41
       41
       -
           with the given variables. Template uses {accountId}, {blobId},

     

       42
       42
       -
           {type}, and {name} placeholders. *)

     

       43
       43
       -
       

     

       44
       44
       -
       (** {1 Blob/copy} *)

     

       45
       45
       -
       

     

       46
       46
       -
       (** Arguments for Blob/copy. *)

     

       47
       47
       -
       type copy_args = {

     

       48
       48
       -
         from_account_id : Id.t;

     

       49
       49
       -
         account_id : Id.t;

     

       50
       50
       -
         blob_ids : Id.t list;

     

       51
       51
       -
       }

     

       52
       52
       -
       

     

       53
       53
       -
       val copy_args_jsont : copy_args Jsont.t

     

       54
       54
       -
       

     

       55
       55
       -
       (** Response for Blob/copy. *)

     

       56
       56
       -
       type copy_response = {

     

       57
       57
       -
         from_account_id : Id.t;

     

       58
       58
       -
         account_id : Id.t;

     

       59
       59
       -
         copied : (Id.t * Id.t) list option;

     

       60
       60
       -
         (** Map of old blob id to new blob id. *)

     

       61
       61
       -
         not_copied : (Id.t * Error.set_error) list option;

     

       62
       62
       -
         (** Blobs that could not be copied. *)

     

       63
       63
       -
       }

     

       64
       64
       -
       

     

       65
       65
       -
       val copy_response_jsont : copy_response Jsont.t

-171

proto/capability.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       let core = "urn:ietf:params:jmap:core"

     

       7
       7
       -
       let mail = "urn:ietf:params:jmap:mail"

     

       8
       8
       -
       let submission = "urn:ietf:params:jmap:submission"

     

       9
       9
       -
       let vacation_response = "urn:ietf:params:jmap:vacationresponse"

     

       10
       10
       -
       

     

       11
       11
       -
       module Core = struct

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           max_size_upload : int64;

     

       14
       14
       -
           max_concurrent_upload : int;

     

       15
       15
       -
           max_size_request : int64;

     

       16
       16
       -
           max_concurrent_requests : int;

     

       17
       17
       -
           max_calls_in_request : int;

     

       18
       18
       -
           max_objects_in_get : int;

     

       19
       19
       -
           max_objects_in_set : int;

     

       20
       20
       -
           collation_algorithms : string list;

     

       21
       21
       -
         }

     

       22
       22
       -
       

     

       23
       23
       -
         let create ~max_size_upload ~max_concurrent_upload ~max_size_request

     

       24
       24
       -
             ~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get

     

       25
       25
       -
             ~max_objects_in_set ~collation_algorithms =

     

       26
       26
       -
           { max_size_upload; max_concurrent_upload; max_size_request;

     

       27
       27
       -
             max_concurrent_requests; max_calls_in_request; max_objects_in_get;

     

       28
       28
       -
             max_objects_in_set; collation_algorithms }

     

       29
       29
       -
       

     

       30
       30
       -
         let max_size_upload t = t.max_size_upload

     

       31
       31
       -
         let max_concurrent_upload t = t.max_concurrent_upload

     

       32
       32
       -
         let max_size_request t = t.max_size_request

     

       33
       33
       -
         let max_concurrent_requests t = t.max_concurrent_requests

     

       34
       34
       -
         let max_calls_in_request t = t.max_calls_in_request

     

       35
       35
       -
         let max_objects_in_get t = t.max_objects_in_get

     

       36
       36
       -
         let max_objects_in_set t = t.max_objects_in_set

     

       37
       37
       -
         let collation_algorithms t = t.collation_algorithms

     

       38
       38
       -
       

     

       39
       39
       -
         let make max_size_upload max_concurrent_upload max_size_request

     

       40
       40
       -
             max_concurrent_requests max_calls_in_request max_objects_in_get

     

       41
       41
       -
             max_objects_in_set collation_algorithms =

     

       42
       42
       -
           { max_size_upload; max_concurrent_upload; max_size_request;

     

       43
       43
       -
             max_concurrent_requests; max_calls_in_request; max_objects_in_get;

     

       44
       44
       -
             max_objects_in_set; collation_algorithms }

     

       45
       45
       -
       

     

       46
       46
       -
         let jsont =

     

       47
       47
       -
           let kind = "Core capability" in

     

       48
       48
       -
           Jsont.Object.map ~kind make

     

       49
       49
       -
           |> Jsont.Object.mem "maxSizeUpload" Int53.Unsigned.jsont ~enc:max_size_upload

     

       50
       50
       -
           |> Jsont.Object.mem "maxConcurrentUpload" Jsont.int ~enc:max_concurrent_upload

     

       51
       51
       -
           |> Jsont.Object.mem "maxSizeRequest" Int53.Unsigned.jsont ~enc:max_size_request

     

       52
       52
       -
           |> Jsont.Object.mem "maxConcurrentRequests" Jsont.int ~enc:max_concurrent_requests

     

       53
       53
       -
           |> Jsont.Object.mem "maxCallsInRequest" Jsont.int ~enc:max_calls_in_request

     

       54
       54
       -
           |> Jsont.Object.mem "maxObjectsInGet" Jsont.int ~enc:max_objects_in_get

     

       55
       55
       -
           |> Jsont.Object.mem "maxObjectsInSet" Jsont.int ~enc:max_objects_in_set

     

       56
       56
       -
           |> Jsont.Object.mem "collationAlgorithms" (Jsont.list Jsont.string) ~enc:collation_algorithms

     

       57
       57
       -
           |> Jsont.Object.finish

     

       58
       58
       -
       end

     

       59
       59
       -
       

     

       60
       60
       -
       module Mail = struct

     

       61
       61
       -
         type t = {

     

       62
       62
       -
           max_mailboxes_per_email : int64 option;

     

       63
       63
       -
           max_mailbox_depth : int64 option;

     

       64
       64
       -
           max_size_mailbox_name : int64;

     

       65
       65
       -
           max_size_attachments_per_email : int64;

     

       66
       66
       -
           email_query_sort_options : string list;

     

       67
       67
       -
           may_create_top_level_mailbox : bool;

     

       68
       68
       -
         }

     

       69
       69
       -
       

     

       70
       70
       -
         let create ?max_mailboxes_per_email ?max_mailbox_depth ~max_size_mailbox_name

     

       71
       71
       -
             ~max_size_attachments_per_email ~email_query_sort_options

     

       72
       72
       -
             ~may_create_top_level_mailbox () =

     

       73
       73
       -
           { max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;

     

       74
       74
       -
             max_size_attachments_per_email; email_query_sort_options;

     

       75
       75
       -
             may_create_top_level_mailbox }

     

       76
       76
       -
       

     

       77
       77
       -
         let max_mailboxes_per_email t = t.max_mailboxes_per_email

     

       78
       78
       -
         let max_mailbox_depth t = t.max_mailbox_depth

     

       79
       79
       -
         let max_size_mailbox_name t = t.max_size_mailbox_name

     

       80
       80
       -
         let max_size_attachments_per_email t = t.max_size_attachments_per_email

     

       81
       81
       -
         let email_query_sort_options t = t.email_query_sort_options

     

       82
       82
       -
         let may_create_top_level_mailbox t = t.may_create_top_level_mailbox

     

       83
       83
       -
       

     

       84
       84
       -
         let make max_mailboxes_per_email max_mailbox_depth max_size_mailbox_name

     

       85
       85
       -
             max_size_attachments_per_email email_query_sort_options

     

       86
       86
       -
             may_create_top_level_mailbox =

     

       87
       87
       -
           { max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;

     

       88
       88
       -
             max_size_attachments_per_email; email_query_sort_options;

     

       89
       89
       -
             may_create_top_level_mailbox }

     

       90
       90
       -
       

     

       91
       91
       -
         let jsont =

     

       92
       92
       -
           let kind = "Mail capability" in

     

       93
       93
       -
           Jsont.Object.map ~kind make

     

       94
       94
       -
           |> Jsont.Object.opt_mem "maxMailboxesPerEmail" Int53.Unsigned.jsont ~enc:max_mailboxes_per_email

     

       95
       95
       -
           |> Jsont.Object.opt_mem "maxMailboxDepth" Int53.Unsigned.jsont ~enc:max_mailbox_depth

     

       96
       96
       -
           |> Jsont.Object.mem "maxSizeMailboxName" Int53.Unsigned.jsont ~enc:max_size_mailbox_name

     

       97
       97
       -
           |> Jsont.Object.mem "maxSizeAttachmentsPerEmail" Int53.Unsigned.jsont ~enc:max_size_attachments_per_email

     

       98
       98
       -
           |> Jsont.Object.mem "emailQuerySortOptions" (Jsont.list Jsont.string) ~enc:email_query_sort_options

     

       99
       99
       -
           |> Jsont.Object.mem "mayCreateTopLevelMailbox" Jsont.bool ~enc:may_create_top_level_mailbox

     

       100
       100
       -
           |> Jsont.Object.finish

     

       101
       101
       -
       end

     

       102
       102
       -
       

     

       103
       103
       -
       module Submission = struct

     

       104
       104
       -
         type t = {

     

       105
       105
       -
           max_delayed_send : int64;

     

       106
       106
       -
           submission_extensions : (string * string list) list;

     

       107
       107
       -
         }

     

       108
       108
       -
       

     

       109
       109
       -
         let create ~max_delayed_send ~submission_extensions =

     

       110
       110
       -
           { max_delayed_send; submission_extensions }

     

       111
       111
       -
       

     

       112
       112
       -
         let max_delayed_send t = t.max_delayed_send

     

       113
       113
       -
         let submission_extensions t = t.submission_extensions

     

       114
       114
       -
       

     

       115
       115
       -
         let make max_delayed_send submission_extensions =

     

       116
       116
       -
           { max_delayed_send; submission_extensions }

     

       117
       117
       -
       

     

       118
       118
       -
         let submission_extensions_jsont =

     

       119
       119
       -
           Json_map.of_string (Jsont.list Jsont.string)

     

       120
       120
       -
       

     

       121
       121
       -
         let jsont =

     

       122
       122
       -
           let kind = "Submission capability" in

     

       123
       123
       -
           Jsont.Object.map ~kind make

     

       124
       124
       -
           |> Jsont.Object.mem "maxDelayedSend" Int53.Unsigned.jsont ~enc:max_delayed_send

     

       125
       125
       -
           |> Jsont.Object.mem "submissionExtensions" submission_extensions_jsont ~enc:submission_extensions

     

       126
       126
       -
           |> Jsont.Object.finish

     

       127
       127
       -
       end

     

       128
       128
       -
       

     

       129
       129
       -
       type capability =

     

       130
       130
       -
         | Core of Core.t

     

       131
       131
       -
         | Mail of Mail.t

     

       132
       132
       -
         | Submission of Submission.t

     

       133
       133
       -
         | Vacation_response

     

       134
       134
       -
         | Unknown of Jsont.json

     

       135
       135
       -
       

     

       136
       136
       -
       let capability_of_json uri json =

     

       137
       137
       -
         match uri with

     

       138
       138
       -
         | u when u = core ->

     

       139
       139
       -
           (match Jsont.Json.decode' Core.jsont json with

     

       140
       140
       -
            | Ok c -> Core c

     

       141
       141
       -
            | Error _ -> Unknown json)

     

       142
       142
       -
         | u when u = mail ->

     

       143
       143
       -
           (match Jsont.Json.decode' Mail.jsont json with

     

       144
       144
       -
            | Ok m -> Mail m

     

       145
       145
       -
            | Error _ -> Unknown json)

     

       146
       146
       -
         | u when u = submission ->

     

       147
       147
       -
           (match Jsont.Json.decode' Submission.jsont json with

     

       148
       148
       -
            | Ok s -> Submission s

     

       149
       149
       -
            | Error _ -> Unknown json)

     

       150
       150
       -
         | u when u = vacation_response ->

     

       151
       151
       -
           Vacation_response

     

       152
       152
       -
         | _ ->

     

       153
       153
       -
           Unknown json

     

       154
       154
       -
       

     

       155
       155
       -
       let capability_to_json (uri, cap) =

     

       156
       156
       -
         let encode jsont v =

     

       157
       157
       -
           match Jsont.Json.encode' jsont v with

     

       158
       158
       -
           | Ok json -> json

     

       159
       159
       -
           | Error _ -> Jsont.Object ([], Jsont.Meta.none)

     

       160
       160
       -
         in

     

       161
       161
       -
         match cap with

     

       162
       162
       -
         | Core c ->

     

       163
       163
       -
           (uri, encode Core.jsont c)

     

       164
       164
       -
         | Mail m ->

     

       165
       165
       -
           (uri, encode Mail.jsont m)

     

       166
       166
       -
         | Submission s ->

     

       167
       167
       -
           (uri, encode Submission.jsont s)

     

       168
       168
       -
         | Vacation_response ->

     

       169
       169
       -
           (uri, Jsont.Object ([], Jsont.Meta.none))

     

       170
       170
       -
         | Unknown json ->

     

       171
       171
       -
           (uri, json)

-143

proto/capability.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP capability types as defined in RFC 8620 Section 2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Standard Capability URIs} *)

     

       9
       9
       -
       

     

       10
       10
       -
       val core : string

     

       11
       11
       -
       (** [urn:ietf:params:jmap:core] - Core JMAP capability (RFC 8620) *)

     

       12
       12
       -
       

     

       13
       13
       -
       val mail : string

     

       14
       14
       -
       (** [urn:ietf:params:jmap:mail] - Mail capability (RFC 8621) *)

     

       15
       15
       -
       

     

       16
       16
       -
       val submission : string

     

       17
       17
       -
       (** [urn:ietf:params:jmap:submission] - Email submission capability (RFC 8621) *)

     

       18
       18
       -
       

     

       19
       19
       -
       val vacation_response : string

     

       20
       20
       -
       (** [urn:ietf:params:jmap:vacationresponse] - Vacation response capability (RFC 8621) *)

     

       21
       21
       -
       

     

       22
       22
       -
       (** {1 Core Capability Object} *)

     

       23
       23
       -
       

     

       24
       24
       -
       (** Core capability limits and configuration per RFC 8620 Section 2. *)

     

       25
       25
       -
       module Core : sig

     

       26
       26
       -
         type t = {

     

       27
       27
       -
           max_size_upload : int64;

     

       28
       28
       -
           (** Maximum size in octets for a single blob upload. *)

     

       29
       29
       -
           max_concurrent_upload : int;

     

       30
       30
       -
           (** Maximum number of concurrent upload requests. *)

     

       31
       31
       -
           max_size_request : int64;

     

       32
       32
       -
           (** Maximum size in octets of a single request. *)

     

       33
       33
       -
           max_concurrent_requests : int;

     

       34
       34
       -
           (** Maximum number of concurrent requests. *)

     

       35
       35
       -
           max_calls_in_request : int;

     

       36
       36
       -
           (** Maximum number of method calls in a single request. *)

     

       37
       37
       -
           max_objects_in_get : int;

     

       38
       38
       -
           (** Maximum number of objects in a single /get request. *)

     

       39
       39
       -
           max_objects_in_set : int;

     

       40
       40
       -
           (** Maximum number of objects in a single /set request. *)

     

       41
       41
       -
           collation_algorithms : string list;

     

       42
       42
       -
           (** Supported collation algorithms for sorting. *)

     

       43
       43
       -
         }

     

       44
       44
       -
       

     

       45
       45
       -
         val create :

     

       46
       46
       -
           max_size_upload:int64 ->

     

       47
       47
       -
           max_concurrent_upload:int ->

     

       48
       48
       -
           max_size_request:int64 ->

     

       49
       49
       -
           max_concurrent_requests:int ->

     

       50
       50
       -
           max_calls_in_request:int ->

     

       51
       51
       -
           max_objects_in_get:int ->

     

       52
       52
       -
           max_objects_in_set:int ->

     

       53
       53
       -
           collation_algorithms:string list ->

     

       54
       54
       -
           t

     

       55
       55
       -
       

     

       56
       56
       -
         val max_size_upload : t -> int64

     

       57
       57
       -
         val max_concurrent_upload : t -> int

     

       58
       58
       -
         val max_size_request : t -> int64

     

       59
       59
       -
         val max_concurrent_requests : t -> int

     

       60
       60
       -
         val max_calls_in_request : t -> int

     

       61
       61
       -
         val max_objects_in_get : t -> int

     

       62
       62
       -
         val max_objects_in_set : t -> int

     

       63
       63
       -
         val collation_algorithms : t -> string list

     

       64
       64
       -
       

     

       65
       65
       -
         val jsont : t Jsont.t

     

       66
       66
       -
         (** JSON codec for core capability. *)

     

       67
       67
       -
       end

     

       68
       68
       -
       

     

       69
       69
       -
       (** {1 Mail Capability Object} *)

     

       70
       70
       -
       

     

       71
       71
       -
       (** Mail capability configuration per RFC 8621. *)

     

       72
       72
       -
       module Mail : sig

     

       73
       73
       -
         type t = {

     

       74
       74
       -
           max_mailboxes_per_email : int64 option;

     

       75
       75
       -
           (** Maximum number of mailboxes an email can belong to. *)

     

       76
       76
       -
           max_mailbox_depth : int64 option;

     

       77
       77
       -
           (** Maximum depth of mailbox hierarchy. *)

     

       78
       78
       -
           max_size_mailbox_name : int64;

     

       79
       79
       -
           (** Maximum size of a mailbox name in octets. *)

     

       80
       80
       -
           max_size_attachments_per_email : int64;

     

       81
       81
       -
           (** Maximum total size of attachments per email. *)

     

       82
       82
       -
           email_query_sort_options : string list;

     

       83
       83
       -
           (** Supported sort options for Email/query. *)

     

       84
       84
       -
           may_create_top_level_mailbox : bool;

     

       85
       85
       -
           (** Whether the user may create top-level mailboxes. *)

     

       86
       86
       -
         }

     

       87
       87
       -
       

     

       88
       88
       -
         val create :

     

       89
       89
       -
           ?max_mailboxes_per_email:int64 ->

     

       90
       90
       -
           ?max_mailbox_depth:int64 ->

     

       91
       91
       -
           max_size_mailbox_name:int64 ->

     

       92
       92
       -
           max_size_attachments_per_email:int64 ->

     

       93
       93
       -
           email_query_sort_options:string list ->

     

       94
       94
       -
           may_create_top_level_mailbox:bool ->

     

       95
       95
       -
           unit ->

     

       96
       96
       -
           t

     

       97
       97
       -
       

     

       98
       98
       -
         val max_mailboxes_per_email : t -> int64 option

     

       99
       99
       -
         val max_mailbox_depth : t -> int64 option

     

       100
       100
       -
         val max_size_mailbox_name : t -> int64

     

       101
       101
       -
         val max_size_attachments_per_email : t -> int64

     

       102
       102
       -
         val email_query_sort_options : t -> string list

     

       103
       103
       -
         val may_create_top_level_mailbox : t -> bool

     

       104
       104
       -
       

     

       105
       105
       -
         val jsont : t Jsont.t

     

       106
       106
       -
       end

     

       107
       107
       -
       

     

       108
       108
       -
       (** {1 Submission Capability Object} *)

     

       109
       109
       -
       

     

       110
       110
       -
       module Submission : sig

     

       111
       111
       -
         type t = {

     

       112
       112
       -
           max_delayed_send : int64;

     

       113
       113
       -
           (** Maximum delay in seconds for delayed sending (0 = not supported). *)

     

       114
       114
       -
           submission_extensions : (string * string list) list;

     

       115
       115
       -
           (** SMTP extensions supported. *)

     

       116
       116
       -
         }

     

       117
       117
       -
       

     

       118
       118
       -
         val create :

     

       119
       119
       -
           max_delayed_send:int64 ->

     

       120
       120
       -
           submission_extensions:(string * string list) list ->

     

       121
       121
       -
           t

     

       122
       122
       -
       

     

       123
       123
       -
         val max_delayed_send : t -> int64

     

       124
       124
       -
         val submission_extensions : t -> (string * string list) list

     

       125
       125
       -
       

     

       126
       126
       -
         val jsont : t Jsont.t

     

       127
       127
       -
       end

     

       128
       128
       -
       

     

       129
       129
       -
       (** {1 Generic Capability Handling} *)

     

       130
       130
       -
       

     

       131
       131
       -
       (** A capability value that can be either a known type or unknown JSON. *)

     

       132
       132
       -
       type capability =

     

       133
       133
       -
         | Core of Core.t

     

       134
       134
       -
         | Mail of Mail.t

     

       135
       135
       -
         | Submission of Submission.t

     

       136
       136
       -
         | Vacation_response  (* No configuration *)

     

       137
       137
       -
         | Unknown of Jsont.json

     

       138
       138
       -
       

     

       139
       139
       -
       val capability_of_json : string -> Jsont.json -> capability

     

       140
       140
       -
       (** [capability_of_json uri json] parses a capability from its URI and JSON value. *)

     

       141
       141
       -
       

     

       142
       142
       -
       val capability_to_json : string * capability -> string * Jsont.json

     

       143
       143
       -
       (** [capability_to_json (uri, cap)] encodes a capability to URI and JSON. *)

-64

proto/date.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Date and time types for JMAP.

     

       7
       7
       -
       

     

       8
       8
       -
           JMAP uses RFC 3339 formatted date-time strings. *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** RFC 3339 date-time with any timezone offset *)

     

       11
       11
       -
       module Rfc3339 = struct

     

       12
       12
       -
         type t = Ptime.t

     

       13
       13
       -
       

     

       14
       14
       -
         let of_string s =

     

       15
       15
       -
           match Ptime.of_rfc3339 s with

     

       16
       16
       -
           | Ok (t, _, _) -> Ok t

     

       17
       17
       -
           | Error _ -> Error (Printf.sprintf "Invalid RFC 3339 date: %s" s)

     

       18
       18
       -
       

     

       19
       19
       -
         let to_string t =

     

       20
       20
       -
           (* Format with 'T' separator and timezone offset *)

     

       21
       21
       -
           Ptime.to_rfc3339 ~tz_offset_s:0 t

     

       22
       22
       -
       

     

       23
       23
       -
         let jsont =

     

       24
       24
       -
           let kind = "Date" in

     

       25
       25
       -
           let dec s =

     

       26
       26
       -
             match of_string s with

     

       27
       27
       -
             | Ok t -> t

     

       28
       28
       -
             | Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg

     

       29
       29
       -
           in

     

       30
       30
       -
           let enc = to_string in

     

       31
       31
       -
           Jsont.map ~kind ~dec ~enc Jsont.string

     

       32
       32
       -
       end

     

       33
       33
       -
       

     

       34
       34
       -
       (** UTC date-time (must use 'Z' timezone suffix) *)

     

       35
       35
       -
       module Utc = struct

     

       36
       36
       -
         type t = Ptime.t

     

       37
       37
       -
       

     

       38
       38
       -
         let of_string s =

     

       39
       39
       -
           (* Must end with 'Z' for UTC *)

     

       40
       40
       -
           let len = String.length s in

     

       41
       41
       -
           if len > 0 && s.[len - 1] <> 'Z' then

     

       42
       42
       -
             Error "UTCDate must use 'Z' timezone suffix"

     

       43
       43
       -
           else

     

       44
       44
       -
             match Ptime.of_rfc3339 s with

     

       45
       45
       -
             | Ok (t, _, _) -> Ok t

     

       46
       46
       -
             | Error _ -> Error (Printf.sprintf "Invalid RFC 3339 UTC date: %s" s)

     

       47
       47
       -
       

     

       48
       48
       -
         let to_string t =

     

       49
       49
       -
           (* Always format with 'Z' suffix *)

     

       50
       50
       -
           Ptime.to_rfc3339 ~tz_offset_s:0 t

     

       51
       51
       -
       

     

       52
       52
       -
         let of_ptime t = t

     

       53
       53
       -
         let to_ptime t = t

     

       54
       54
       -
       

     

       55
       55
       -
         let jsont =

     

       56
       56
       -
           let kind = "UTCDate" in

     

       57
       57
       -
           let dec s =

     

       58
       58
       -
             match of_string s with

     

       59
       59
       -
             | Ok t -> t

     

       60
       60
       -
             | Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg

     

       61
       61
       -
           in

     

       62
       62
       -
           let enc = to_string in

     

       63
       63
       -
           Jsont.map ~kind ~dec ~enc Jsont.string

     

       64
       64
       -
       end

-51

proto/date.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Date and time types for JMAP.

     

       7
       7
       -
       

     

       8
       8
       -
           JMAP uses RFC 3339 formatted date-time strings.

     

       9
       9
       -
       

     

       10
       10
       -
           See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.4} RFC 8620 Section 1.4}. *)

     

       11
       11
       -
       

     

       12
       12
       -
       (** RFC 3339 date-time.

     

       13
       13
       -
       

     

       14
       14
       -
           A date-time string with uppercase 'T' separator. May have any timezone. *)

     

       15
       15
       -
       module Rfc3339 : sig

     

       16
       16
       -
         type t = Ptime.t

     

       17
       17
       -
         (** The type of dates. *)

     

       18
       18
       -
       

     

       19
       19
       -
         val of_string : string -> (t, string) result

     

       20
       20
       -
         (** [of_string s] parses an RFC 3339 date-time string. *)

     

       21
       21
       -
       

     

       22
       22
       -
         val to_string : t -> string

     

       23
       23
       -
         (** [to_string d] formats [d] as an RFC 3339 string. *)

     

       24
       24
       -
       

     

       25
       25
       -
         val jsont : t Jsont.t

     

       26
       26
       -
         (** JSON codec for RFC 3339 dates. *)

     

       27
       27
       -
       end

     

       28
       28
       -
       

     

       29
       29
       -
       (** UTC date-time.

     

       30
       30
       -
       

     

       31
       31
       -
           A date-time string that MUST have 'Z' as the timezone (UTC only). *)

     

       32
       32
       -
       module Utc : sig

     

       33
       33
       -
         type t = Ptime.t

     

       34
       34
       -
         (** The type of UTC dates. *)

     

       35
       35
       -
       

     

       36
       36
       -
         val of_string : string -> (t, string) result

     

       37
       37
       -
         (** [of_string s] parses an RFC 3339 UTC date-time string.

     

       38
       38
       -
             Returns error if timezone is not 'Z'. *)

     

       39
       39
       -
       

     

       40
       40
       -
         val to_string : t -> string

     

       41
       41
       -
         (** [to_string d] formats [d] as an RFC 3339 UTC string with 'Z'. *)

     

       42
       42
       -
       

     

       43
       43
       -
         val of_ptime : Ptime.t -> t

     

       44
       44
       -
         (** [of_ptime p] creates a UTC date from a Ptime value. *)

     

       45
       45
       -
       

     

       46
       46
       -
         val to_ptime : t -> Ptime.t

     

       47
       47
       -
         (** [to_ptime d] returns the underlying Ptime value. *)

     

       48
       48
       -
       

     

       49
       49
       -
         val jsont : t Jsont.t

     

       50
       50
       -
         (** JSON codec for UTC dates. *)

     

       51
       51
       -
       end

-21

proto/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name jmap_proto)

     

       3
       3
       -
        (public_name jmap)

     

       4
       4
       -
        (libraries jsont ptime)

     

       5
       5
       -
        (modules

     

       6
       6
       -
         jmap_proto

     

       7
       7
       -
         id

     

       8
       8
       -
         int53

     

       9
       9
       -
         date

     

       10
       10
       -
         json_map

     

       11
       11
       -
         unknown

     

       12
       12
       -
         error

     

       13
       13
       -
         capability

     

       14
       14
       -
         filter

     

       15
       15
       -
         method_

     

       16
       16
       -
         invocation

     

       17
       17
       -
         request

     

       18
       18
       -
         response

     

       19
       19
       -
         session

     

       20
       20
       -
         push

     

       21
       21
       -
         blob))

-190

proto/error.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Request_error = struct

     

       7
       7
       -
         type urn =

     

       8
       8
       -
           | Unknown_capability

     

       9
       9
       -
           | Not_json

     

       10
       10
       -
           | Not_request

     

       11
       11
       -
           | Limit

     

       12
       12
       -
           | Other of string

     

       13
       13
       -
       

     

       14
       14
       -
         let urn_to_string = function

     

       15
       15
       -
           | Unknown_capability -> "urn:ietf:params:jmap:error:unknownCapability"

     

       16
       16
       -
           | Not_json -> "urn:ietf:params:jmap:error:notJSON"

     

       17
       17
       -
           | Not_request -> "urn:ietf:params:jmap:error:notRequest"

     

       18
       18
       -
           | Limit -> "urn:ietf:params:jmap:error:limit"

     

       19
       19
       -
           | Other s -> s

     

       20
       20
       -
       

     

       21
       21
       -
         let urn_of_string = function

     

       22
       22
       -
           | "urn:ietf:params:jmap:error:unknownCapability" -> Unknown_capability

     

       23
       23
       -
           | "urn:ietf:params:jmap:error:notJSON" -> Not_json

     

       24
       24
       -
           | "urn:ietf:params:jmap:error:notRequest" -> Not_request

     

       25
       25
       -
           | "urn:ietf:params:jmap:error:limit" -> Limit

     

       26
       26
       -
           | s -> Other s

     

       27
       27
       -
       

     

       28
       28
       -
         let urn_jsont =

     

       29
       29
       -
           let kind = "Request error URN" in

     

       30
       30
       -
           Jsont.map ~kind

     

       31
       31
       -
             ~dec:(fun s -> urn_of_string s)

     

       32
       32
       -
             ~enc:urn_to_string

     

       33
       33
       -
             Jsont.string

     

       34
       34
       -
       

     

       35
       35
       -
         type t = {

     

       36
       36
       -
           type_ : urn;

     

       37
       37
       -
           status : int;

     

       38
       38
       -
           title : string option;

     

       39
       39
       -
           detail : string option;

     

       40
       40
       -
           limit : string option;

     

       41
       41
       -
         }

     

       42
       42
       -
       

     

       43
       43
       -
         let make type_ status title detail limit =

     

       44
       44
       -
           { type_; status; title; detail; limit }

     

       45
       45
       -
       

     

       46
       46
       -
         let type_ t = t.type_

     

       47
       47
       -
         let status t = t.status

     

       48
       48
       -
         let title t = t.title

     

       49
       49
       -
         let detail t = t.detail

     

       50
       50
       -
         let limit t = t.limit

     

       51
       51
       -
       

     

       52
       52
       -
         let jsont =

     

       53
       53
       -
           let kind = "Request error" in

     

       54
       54
       -
           Jsont.Object.map ~kind make

     

       55
       55
       -
           |> Jsont.Object.mem "type" urn_jsont ~enc:type_

     

       56
       56
       -
           |> Jsont.Object.mem "status" Jsont.int ~enc:status

     

       57
       57
       -
           |> Jsont.Object.opt_mem "title" Jsont.string ~enc:title

     

       58
       58
       -
           |> Jsont.Object.opt_mem "detail" Jsont.string ~enc:detail

     

       59
       59
       -
           |> Jsont.Object.opt_mem "limit" Jsont.string ~enc:limit

     

       60
       60
       -
           |> Jsont.Object.finish

     

       61
       61
       -
       end

     

       62
       62
       -
       

     

       63
       63
       -
       type method_error_type =

     

       64
       64
       -
         | Server_unavailable

     

       65
       65
       -
         | Server_fail

     

       66
       66
       -
         | Server_partial_fail

     

       67
       67
       -
         | Unknown_method

     

       68
       68
       -
         | Invalid_arguments

     

       69
       69
       -
         | Invalid_result_reference

     

       70
       70
       -
         | Forbidden

     

       71
       71
       -
         | Account_not_found

     

       72
       72
       -
         | Account_not_supported_by_method

     

       73
       73
       -
         | Account_read_only

     

       74
       74
       -
         | Other of string

     

       75
       75
       -
       

     

       76
       76
       -
       let method_error_type_to_string = function

     

       77
       77
       -
         | Server_unavailable -> "serverUnavailable"

     

       78
       78
       -
         | Server_fail -> "serverFail"

     

       79
       79
       -
         | Server_partial_fail -> "serverPartialFail"

     

       80
       80
       -
         | Unknown_method -> "unknownMethod"

     

       81
       81
       -
         | Invalid_arguments -> "invalidArguments"

     

       82
       82
       -
         | Invalid_result_reference -> "invalidResultReference"

     

       83
       83
       -
         | Forbidden -> "forbidden"

     

       84
       84
       -
         | Account_not_found -> "accountNotFound"

     

       85
       85
       -
         | Account_not_supported_by_method -> "accountNotSupportedByMethod"

     

       86
       86
       -
         | Account_read_only -> "accountReadOnly"

     

       87
       87
       -
         | Other s -> s

     

       88
       88
       -
       

     

       89
       89
       -
       let method_error_type_of_string = function

     

       90
       90
       -
         | "serverUnavailable" -> Server_unavailable

     

       91
       91
       -
         | "serverFail" -> Server_fail

     

       92
       92
       -
         | "serverPartialFail" -> Server_partial_fail

     

       93
       93
       -
         | "unknownMethod" -> Unknown_method

     

       94
       94
       -
         | "invalidArguments" -> Invalid_arguments

     

       95
       95
       -
         | "invalidResultReference" -> Invalid_result_reference

     

       96
       96
       -
         | "forbidden" -> Forbidden

     

       97
       97
       -
         | "accountNotFound" -> Account_not_found

     

       98
       98
       -
         | "accountNotSupportedByMethod" -> Account_not_supported_by_method

     

       99
       99
       -
         | "accountReadOnly" -> Account_read_only

     

       100
       100
       -
         | s -> Other s

     

       101
       101
       -
       

     

       102
       102
       -
       let method_error_type_jsont =

     

       103
       103
       -
         let kind = "Method error type" in

     

       104
       104
       -
         Jsont.map ~kind

     

       105
       105
       -
           ~dec:(fun s -> method_error_type_of_string s)

     

       106
       106
       -
           ~enc:method_error_type_to_string

     

       107
       107
       -
           Jsont.string

     

       108
       108
       -
       

     

       109
       109
       -
       type method_error = {

     

       110
       110
       -
         type_ : method_error_type;

     

       111
       111
       -
         description : string option;

     

       112
       112
       -
       }

     

       113
       113
       -
       

     

       114
       114
       -
       let method_error_make type_ description = { type_; description }

     

       115
       115
       -
       let method_error_type_ t = t.type_

     

       116
       116
       -
       let method_error_description t = t.description

     

       117
       117
       -
       

     

       118
       118
       -
       let method_error_jsont =

     

       119
       119
       -
         let kind = "Method error" in

     

       120
       120
       -
         Jsont.Object.map ~kind method_error_make

     

       121
       121
       -
         |> Jsont.Object.mem "type" method_error_type_jsont ~enc:method_error_type_

     

       122
       122
       -
         |> Jsont.Object.opt_mem "description" Jsont.string ~enc:method_error_description

     

       123
       123
       -
         |> Jsont.Object.finish

     

       124
       124
       -
       

     

       125
       125
       -
       type set_error_type =

     

       126
       126
       -
         | Forbidden

     

       127
       127
       -
         | Over_quota

     

       128
       128
       -
         | Too_large

     

       129
       129
       -
         | Rate_limit

     

       130
       130
       -
         | Not_found

     

       131
       131
       -
         | Invalid_patch

     

       132
       132
       -
         | Will_destroy

     

       133
       133
       -
         | Invalid_properties

     

       134
       134
       -
         | Singleton

     

       135
       135
       -
         | Other of string

     

       136
       136
       -
       

     

       137
       137
       -
       let set_error_type_to_string = function

     

       138
       138
       -
         | Forbidden -> "forbidden"

     

       139
       139
       -
         | Over_quota -> "overQuota"

     

       140
       140
       -
         | Too_large -> "tooLarge"

     

       141
       141
       -
         | Rate_limit -> "rateLimit"

     

       142
       142
       -
         | Not_found -> "notFound"

     

       143
       143
       -
         | Invalid_patch -> "invalidPatch"

     

       144
       144
       -
         | Will_destroy -> "willDestroy"

     

       145
       145
       -
         | Invalid_properties -> "invalidProperties"

     

       146
       146
       -
         | Singleton -> "singleton"

     

       147
       147
       -
         | Other s -> s

     

       148
       148
       -
       

     

       149
       149
       -
       let set_error_type_of_string = function

     

       150
       150
       -
         | "forbidden" -> Forbidden

     

       151
       151
       -
         | "overQuota" -> Over_quota

     

       152
       152
       -
         | "tooLarge" -> Too_large

     

       153
       153
       -
         | "rateLimit" -> Rate_limit

     

       154
       154
       -
         | "notFound" -> Not_found

     

       155
       155
       -
         | "invalidPatch" -> Invalid_patch

     

       156
       156
       -
         | "willDestroy" -> Will_destroy

     

       157
       157
       -
         | "invalidProperties" -> Invalid_properties

     

       158
       158
       -
         | "singleton" -> Singleton

     

       159
       159
       -
         | s -> Other s

     

       160
       160
       -
       

     

       161
       161
       -
       let set_error_type_jsont =

     

       162
       162
       -
         let kind = "SetError type" in

     

       163
       163
       -
         Jsont.map ~kind

     

       164
       164
       -
           ~dec:(fun s -> set_error_type_of_string s)

     

       165
       165
       -
           ~enc:set_error_type_to_string

     

       166
       166
       -
           Jsont.string

     

       167
       167
       -
       

     

       168
       168
       -
       type set_error = {

     

       169
       169
       -
         type_ : set_error_type;

     

       170
       170
       -
         description : string option;

     

       171
       171
       -
         properties : string list option;

     

       172
       172
       -
       }

     

       173
       173
       -
       

     

       174
       174
       -
       let set_error ?description ?properties type_ =

     

       175
       175
       -
         { type_; description; properties }

     

       176
       176
       -
       

     

       177
       177
       -
       let set_error_make type_ description properties =

     

       178
       178
       -
         { type_; description; properties }

     

       179
       179
       -
       

     

       180
       180
       -
       let set_error_type_ t = t.type_

     

       181
       181
       -
       let set_error_description t = t.description

     

       182
       182
       -
       let set_error_properties t = t.properties

     

       183
       183
       -
       

     

       184
       184
       -
       let set_error_jsont =

     

       185
       185
       -
         let kind = "SetError" in

     

       186
       186
       -
         Jsont.Object.map ~kind set_error_make

     

       187
       187
       -
         |> Jsont.Object.mem "type" set_error_type_jsont ~enc:set_error_type_

     

       188
       188
       -
         |> Jsont.Object.opt_mem "description" Jsont.string ~enc:set_error_description

     

       189
       189
       -
         |> Jsont.Object.opt_mem "properties" (Jsont.list Jsont.string) ~enc:set_error_properties

     

       190
       190
       -
         |> Jsont.Object.finish

-146

proto/error.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP error types as defined in RFC 8620 Section 3.6.1-3.6.2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Request-Level Errors}

     

       9
       9
       -
       

     

       10
       10
       -
           These errors are returned with an HTTP error status code and a JSON

     

       11
       11
       -
           Problem Details body (RFC 7807). *)

     

       12
       12
       -
       

     

       13
       13
       -
       (** Request-level error URNs *)

     

       14
       14
       -
       module Request_error : sig

     

       15
       15
       -
         type urn =

     

       16
       16
       -
           | Unknown_capability

     

       17
       17
       -
           (** urn:ietf:params:jmap:error:unknownCapability

     

       18
       18
       -
               The client included a capability in "using" that the server does not support. *)

     

       19
       19
       -
           | Not_json

     

       20
       20
       -
           (** urn:ietf:params:jmap:error:notJSON

     

       21
       21
       -
               The content type was not application/json or the request was not valid JSON. *)

     

       22
       22
       -
           | Not_request

     

       23
       23
       -
           (** urn:ietf:params:jmap:error:notRequest

     

       24
       24
       -
               The request was valid JSON but not a valid JMAP Request object. *)

     

       25
       25
       -
           | Limit

     

       26
       26
       -
           (** urn:ietf:params:jmap:error:limit

     

       27
       27
       -
               A server-defined limit was reached. *)

     

       28
       28
       -
           | Other of string

     

       29
       29
       -
           (** Other URN not in the standard set. *)

     

       30
       30
       -
       

     

       31
       31
       -
         val urn_to_string : urn -> string

     

       32
       32
       -
         (** [urn_to_string urn] returns the URN string. *)

     

       33
       33
       -
       

     

       34
       34
       -
         val urn_of_string : string -> urn

     

       35
       35
       -
         (** [urn_of_string s] parses a URN string. *)

     

       36
       36
       -
       

     

       37
       37
       -
         type t = {

     

       38
       38
       -
           type_ : urn;

     

       39
       39
       -
           (** The error type URN. *)

     

       40
       40
       -
           status : int;

     

       41
       41
       -
           (** HTTP status code. *)

     

       42
       42
       -
           title : string option;

     

       43
       43
       -
           (** Short human-readable summary. *)

     

       44
       44
       -
           detail : string option;

     

       45
       45
       -
           (** Longer human-readable explanation. *)

     

       46
       46
       -
           limit : string option;

     

       47
       47
       -
           (** For "limit" errors, the name of the limit that was exceeded. *)

     

       48
       48
       -
         }

     

       49
       49
       -
         (** A request-level error per RFC 7807 Problem Details. *)

     

       50
       50
       -
       

     

       51
       51
       -
         val jsont : t Jsont.t

     

       52
       52
       -
         (** JSON codec for request-level errors. *)

     

       53
       53
       -
       end

     

       54
       54
       -
       

     

       55
       55
       -
       (** {1 Method-Level Errors}

     

       56
       56
       -
       

     

       57
       57
       -
           These are returned as the second element of an Invocation tuple

     

       58
       58
       -
           when a method call fails. *)

     

       59
       59
       -
       

     

       60
       60
       -
       (** Standard method error types per RFC 8620 Section 3.6.2 *)

     

       61
       61
       -
       type method_error_type =

     

       62
       62
       -
         | Server_unavailable

     

       63
       63
       -
         (** The server is temporarily unavailable. *)

     

       64
       64
       -
         | Server_fail

     

       65
       65
       -
         (** An unexpected error occurred. *)

     

       66
       66
       -
         | Server_partial_fail

     

       67
       67
       -
         (** Some, but not all, changes were successfully made. *)

     

       68
       68
       -
         | Unknown_method

     

       69
       69
       -
         (** The method name is not recognized. *)

     

       70
       70
       -
         | Invalid_arguments

     

       71
       71
       -
         (** One or more arguments are invalid. *)

     

       72
       72
       -
         | Invalid_result_reference

     

       73
       73
       -
         (** A result reference could not be resolved. *)

     

       74
       74
       -
         | Forbidden

     

       75
       75
       -
         (** The method/arguments are valid but forbidden. *)

     

       76
       76
       -
         | Account_not_found

     

       77
       77
       -
         (** The accountId does not correspond to a valid account. *)

     

       78
       78
       -
         | Account_not_supported_by_method

     

       79
       79
       -
         (** The account does not support this method. *)

     

       80
       80
       -
         | Account_read_only

     

       81
       81
       -
         (** The account is read-only. *)

     

       82
       82
       -
         | Other of string

     

       83
       83
       -
         (** Other error type not in the standard set. *)

     

       84
       84
       -
       

     

       85
       85
       -
       val method_error_type_to_string : method_error_type -> string

     

       86
       86
       -
       (** [method_error_type_to_string t] returns the type string. *)

     

       87
       87
       -
       

     

       88
       88
       -
       val method_error_type_of_string : string -> method_error_type

     

       89
       89
       -
       (** [method_error_type_of_string s] parses a type string. *)

     

       90
       90
       -
       

     

       91
       91
       -
       (** A method-level error response. *)

     

       92
       92
       -
       type method_error = {

     

       93
       93
       -
         type_ : method_error_type;

     

       94
       94
       -
         (** The error type. *)

     

       95
       95
       -
         description : string option;

     

       96
       96
       -
         (** Human-readable description of the error. *)

     

       97
       97
       -
       }

     

       98
       98
       -
       

     

       99
       99
       -
       val method_error_jsont : method_error Jsont.t

     

       100
       100
       -
       (** JSON codec for method errors. *)

     

       101
       101
       -
       

     

       102
       102
       -
       (** {1 SetError}

     

       103
       103
       -
       

     

       104
       104
       -
           Errors returned in notCreated/notUpdated/notDestroyed responses. *)

     

       105
       105
       -
       

     

       106
       106
       -
       (** Standard SetError types per RFC 8620 Section 5.3 *)

     

       107
       107
       -
       type set_error_type =

     

       108
       108
       -
         | Forbidden

     

       109
       109
       -
         (** The operation is not permitted. *)

     

       110
       110
       -
         | Over_quota

     

       111
       111
       -
         (** The maximum server quota has been reached. *)

     

       112
       112
       -
         | Too_large

     

       113
       113
       -
         (** The object is too large. *)

     

       114
       114
       -
         | Rate_limit

     

       115
       115
       -
         (** Too many objects of this type have been created recently. *)

     

       116
       116
       -
         | Not_found

     

       117
       117
       -
         (** The id does not exist (for update/destroy). *)

     

       118
       118
       -
         | Invalid_patch

     

       119
       119
       -
         (** The PatchObject is invalid. *)

     

       120
       120
       -
         | Will_destroy

     

       121
       121
       -
         (** The object will be destroyed by another operation in the request. *)

     

       122
       122
       -
         | Invalid_properties

     

       123
       123
       -
         (** Some properties were invalid. *)

     

       124
       124
       -
         | Singleton

     

       125
       125
       -
         (** Only one object of this type can exist (for create). *)

     

       126
       126
       -
         | Other of string

     

       127
       127
       -
         (** Other error type. *)

     

       128
       128
       -
       

     

       129
       129
       -
       val set_error_type_to_string : set_error_type -> string

     

       130
       130
       -
       val set_error_type_of_string : string -> set_error_type

     

       131
       131
       -
       

     

       132
       132
       -
       (** A SetError object. *)

     

       133
       133
       -
       type set_error = {

     

       134
       134
       -
         type_ : set_error_type;

     

       135
       135
       -
         (** The error type. *)

     

       136
       136
       -
         description : string option;

     

       137
       137
       -
         (** Human-readable description. *)

     

       138
       138
       -
         properties : string list option;

     

       139
       139
       -
         (** For invalidProperties errors, the list of invalid property names. *)

     

       140
       140
       -
       }

     

       141
       141
       -
       

     

       142
       142
       -
       val set_error : ?description:string -> ?properties:string list -> set_error_type -> set_error

     

       143
       143
       -
       (** [set_error ?description ?properties type_] creates a SetError. *)

     

       144
       144
       -
       

     

       145
       145
       -
       val set_error_jsont : set_error Jsont.t

     

       146
       146
       -
       (** JSON codec for SetError. *)

-123

proto/filter.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type operator = And | Or | Not

     

       7
       7
       -
       

     

       8
       8
       -
       let operator_to_string = function

     

       9
       9
       -
         | And -> "AND"

     

       10
       10
       -
         | Or -> "OR"

     

       11
       11
       -
         | Not -> "NOT"

     

       12
       12
       -
       

     

       13
       13
       -
       let operator_of_string = function

     

       14
       14
       -
         | "AND" -> And

     

       15
       15
       -
         | "OR" -> Or

     

       16
       16
       -
         | "NOT" -> Not

     

       17
       17
       -
         | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown filter operator: %s" s

     

       18
       18
       -
       

     

       19
       19
       -
       let operator_jsont =

     

       20
       20
       -
         let kind = "Filter operator" in

     

       21
       21
       -
         Jsont.map ~kind

     

       22
       22
       -
           ~dec:(fun s -> operator_of_string s)

     

       23
       23
       -
           ~enc:operator_to_string

     

       24
       24
       -
           Jsont.string

     

       25
       25
       -
       

     

       26
       26
       -
       type 'condition filter_operator = {

     

       27
       27
       -
         operator : operator;

     

       28
       28
       -
         conditions : 'condition filter list;

     

       29
       29
       -
       }

     

       30
       30
       -
       

     

       31
       31
       -
       and 'condition filter =

     

       32
       32
       -
         | Operator of 'condition filter_operator

     

       33
       33
       -
         | Condition of 'condition

     

       34
       34
       -
       

     

       35
       35
       -
       let filter_jsont (type c) (condition_jsont : c Jsont.t) : c filter Jsont.t =

     

       36
       36
       -
         let kind = "Filter" in

     

       37
       37
       -
         (* Create a recursive codec using Jsont.rec' *)

     

       38
       38
       -
         let rec make_filter_jsont () =

     

       39
       39
       -
           let lazy_self = lazy (make_filter_jsont ()) in

     

       40
       40
       -
           (* Filter operator codec *)

     

       41
       41
       -
           let filter_operator_jsont =

     

       42
       42
       -
             let make operator conditions = { operator; conditions } in

     

       43
       43
       -
             Jsont.Object.map ~kind:"FilterOperator" make

     

       44
       44
       -
             |> Jsont.Object.mem "operator" operator_jsont ~enc:(fun o -> o.operator)

     

       45
       45
       -
             |> Jsont.Object.mem "conditions"

     

       46
       46
       -
                  (Jsont.list (Jsont.rec' lazy_self))

     

       47
       47
       -
                  ~enc:(fun o -> o.conditions)

     

       48
       48
       -
             |> Jsont.Object.finish

     

       49
       49
       -
           in

     

       50
       50
       -
           (* Decode function: check for "operator" field to determine type *)

     

       51
       51
       -
           let dec json =

     

       52
       52
       -
             match json with

     

       53
       53
       -
             | Jsont.Object (members, _) ->

     

       54
       54
       -
               (* members has type (name * json) list where name = string * Meta.t *)

     

       55
       55
       -
               if List.exists (fun ((k, _), _) -> k = "operator") members then begin

     

       56
       56
       -
                 (* It's an operator *)

     

       57
       57
       -
                 match Jsont.Json.decode' filter_operator_jsont json with

     

       58
       58
       -
                 | Ok op -> Operator op

     

       59
       59
       -
                 | Error e -> raise (Jsont.Error e)

     

       60
       60
       -
               end else begin

     

       61
       61
       -
                 (* It's a condition *)

     

       62
       62
       -
                 match Jsont.Json.decode' condition_jsont json with

     

       63
       63
       -
                 | Ok c -> Condition c

     

       64
       64
       -
                 | Error e -> raise (Jsont.Error e)

     

       65
       65
       -
               end

     

       66
       66
       -
             | Jsont.Null _ | Jsont.Bool _ | Jsont.Number _ | Jsont.String _ | Jsont.Array _ ->

     

       67
       67
       -
               Jsont.Error.msg Jsont.Meta.none "Filter must be an object"

     

       68
       68
       -
           in

     

       69
       69
       -
           (* Encode function *)

     

       70
       70
       -
           let enc = function

     

       71
       71
       -
             | Operator op ->

     

       72
       72
       -
               (match Jsont.Json.encode' filter_operator_jsont op with

     

       73
       73
       -
                | Ok j -> j

     

       74
       74
       -
                | Error e -> raise (Jsont.Error e))

     

       75
       75
       -
             | Condition c ->

     

       76
       76
       -
               (match Jsont.Json.encode' condition_jsont c with

     

       77
       77
       -
                | Ok j -> j

     

       78
       78
       -
                | Error e -> raise (Jsont.Error e))

     

       79
       79
       -
           in

     

       80
       80
       -
           Jsont.map ~kind ~dec ~enc Jsont.json

     

       81
       81
       -
         in

     

       82
       82
       -
         make_filter_jsont ()

     

       83
       83
       -
       

     

       84
       84
       -
       type comparator = {

     

       85
       85
       -
         property : string;

     

       86
       86
       -
         is_ascending : bool;

     

       87
       87
       -
         collation : string option;

     

       88
       88
       -
       }

     

       89
       89
       -
       

     

       90
       90
       -
       let comparator ?(is_ascending = true) ?collation property =

     

       91
       91
       -
         { property; is_ascending; collation }

     

       92
       92
       -
       

     

       93
       93
       -
       let comparator_property c = c.property

     

       94
       94
       -
       let comparator_is_ascending c = c.is_ascending

     

       95
       95
       -
       let comparator_collation c = c.collation

     

       96
       96
       -
       

     

       97
       97
       -
       let comparator_make property is_ascending collation =

     

       98
       98
       -
         { property; is_ascending; collation }

     

       99
       99
       -
       

     

       100
       100
       -
       let comparator_jsont =

     

       101
       101
       -
         let kind = "Comparator" in

     

       102
       102
       -
         Jsont.Object.map ~kind comparator_make

     

       103
       103
       -
         |> Jsont.Object.mem "property" Jsont.string ~enc:comparator_property

     

       104
       104
       -
         |> Jsont.Object.mem "isAscending" Jsont.bool ~dec_absent:true ~enc:comparator_is_ascending

     

       105
       105
       -
              ~enc_omit:(fun b -> b = true)

     

       106
       106
       -
         |> Jsont.Object.opt_mem "collation" Jsont.string ~enc:comparator_collation

     

       107
       107
       -
         |> Jsont.Object.finish

     

       108
       108
       -
       

     

       109
       109
       -
       type added_item = {

     

       110
       110
       -
         id : Id.t;

     

       111
       111
       -
         index : int64;

     

       112
       112
       -
       }

     

       113
       113
       -
       

     

       114
       114
       -
       let added_item_make id index = { id; index }

     

       115
       115
       -
       let added_item_id a = a.id

     

       116
       116
       -
       let added_item_index a = a.index

     

       117
       117
       -
       

     

       118
       118
       -
       let added_item_jsont =

     

       119
       119
       -
         let kind = "AddedItem" in

     

       120
       120
       -
         Jsont.Object.map ~kind added_item_make

     

       121
       121
       -
         |> Jsont.Object.mem "id" Id.jsont ~enc:added_item_id

     

       122
       122
       -
         |> Jsont.Object.mem "index" Int53.Unsigned.jsont ~enc:added_item_index

     

       123
       123
       -
         |> Jsont.Object.finish

-73

proto/filter.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP filter and sort types as defined in RFC 8620 Section 5.5 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Filter Operators} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Filter operator types. *)

     

       11
       11
       -
       type operator =

     

       12
       12
       -
         | And  (** All conditions must match *)

     

       13
       13
       -
         | Or   (** At least one condition must match *)

     

       14
       14
       -
         | Not  (** Inverts a single condition *)

     

       15
       15
       -
       

     

       16
       16
       -
       val operator_jsont : operator Jsont.t

     

       17
       17
       -
       (** JSON codec for filter operators. *)

     

       18
       18
       -
       

     

       19
       19
       -
       (** A filter operator that combines conditions.

     

       20
       20
       -
       

     

       21
       21
       -
           When decoding, the filter determines whether a JSON object is an

     

       22
       22
       -
           operator (has "operator" field) or a condition. *)

     

       23
       23
       -
       type 'condition filter_operator = {

     

       24
       24
       -
         operator : operator;

     

       25
       25
       -
         conditions : 'condition filter list;

     

       26
       26
       -
       }

     

       27
       27
       -
       

     

       28
       28
       -
       (** A filter is either an operator combining filters, or a leaf condition. *)

     

       29
       29
       -
       and 'condition filter =

     

       30
       30
       -
         | Operator of 'condition filter_operator

     

       31
       31
       -
         | Condition of 'condition

     

       32
       32
       -
       

     

       33
       33
       -
       val filter_jsont : 'c Jsont.t -> 'c filter Jsont.t

     

       34
       34
       -
       (** [filter_jsont condition_jsont] creates a codec for filters with the

     

       35
       35
       -
           given condition type. The codec automatically distinguishes operators

     

       36
       36
       -
           from conditions by the presence of the "operator" field. *)

     

       37
       37
       -
       

     

       38
       38
       -
       (** {1 Comparators} *)

     

       39
       39
       -
       

     

       40
       40
       -
       (** A comparator for sorting query results. *)

     

       41
       41
       -
       type comparator = {

     

       42
       42
       -
         property : string;

     

       43
       43
       -
         (** The property to sort by. *)

     

       44
       44
       -
         is_ascending : bool;

     

       45
       45
       -
         (** [true] for ascending order (default), [false] for descending. *)

     

       46
       46
       -
         collation : string option;

     

       47
       47
       -
         (** Optional collation algorithm for string comparison. *)

     

       48
       48
       -
       }

     

       49
       49
       -
       

     

       50
       50
       -
       val comparator :

     

       51
       51
       -
         ?is_ascending:bool ->

     

       52
       52
       -
         ?collation:string ->

     

       53
       53
       -
         string ->

     

       54
       54
       -
         comparator

     

       55
       55
       -
       (** [comparator ?is_ascending ?collation property] creates a comparator.

     

       56
       56
       -
           [is_ascending] defaults to [true]. *)

     

       57
       57
       -
       

     

       58
       58
       -
       val comparator_property : comparator -> string

     

       59
       59
       -
       val comparator_is_ascending : comparator -> bool

     

       60
       60
       -
       val comparator_collation : comparator -> string option

     

       61
       61
       -
       

     

       62
       62
       -
       val comparator_jsont : comparator Jsont.t

     

       63
       63
       -
       (** JSON codec for comparators. *)

     

       64
       64
       -
       

     

       65
       65
       -
       (** {1 Position Information} *)

     

       66
       66
       -
       

     

       67
       67
       -
       (** Added entry position in query change results. *)

     

       68
       68
       -
       type added_item = {

     

       69
       69
       -
         id : Id.t;

     

       70
       70
       -
         index : int64;

     

       71
       71
       -
       }

     

       72
       72
       -
       

     

       73
       73
       -
       val added_item_jsont : added_item Jsont.t

-51

proto/id.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP identifier type as defined in RFC 8620 Section 1.2.

     

       7
       7
       -
       

     

       8
       8
       -
           An Id is a string of 1-255 octets from the URL-safe base64 alphabet. *)

     

       9
       9
       -
       

     

       10
       10
       -
       type t = string

     

       11
       11
       -
       

     

       12
       12
       -
       (* Valid characters: A-Za-z0-9_- (URL-safe base64 alphabet) *)

     

       13
       13
       -
       let is_valid_char c =

     

       14
       14
       -
         (c >= 'A' && c <= 'Z') ||

     

       15
       15
       -
         (c >= 'a' && c <= 'z') ||

     

       16
       16
       -
         (c >= '0' && c <= '9') ||

     

       17
       17
       -
         c = '_' || c = '-'

     

       18
       18
       -
       

     

       19
       19
       -
       let validate s =

     

       20
       20
       -
         let len = String.length s in

     

       21
       21
       -
         if len = 0 then Error "Id cannot be empty"

     

       22
       22
       -
         else if len > 255 then Error "Id cannot exceed 255 characters"

     

       23
       23
       -
         else

     

       24
       24
       -
           let rec check i =

     

       25
       25
       -
             if i >= len then Ok s

     

       26
       26
       -
             else if is_valid_char s.[i] then check (i + 1)

     

       27
       27
       -
             else Error (Printf.sprintf "Invalid character '%c' in Id at position %d" s.[i] i)

     

       28
       28
       -
           in

     

       29
       29
       -
           check 0

     

       30
       30
       -
       

     

       31
       31
       -
       let of_string = validate

     

       32
       32
       -
       

     

       33
       33
       -
       let of_string_exn s =

     

       34
       34
       -
         match validate s with

     

       35
       35
       -
         | Ok id -> id

     

       36
       36
       -
         | Error msg -> invalid_arg msg

     

       37
       37
       -
       

     

       38
       38
       -
       let to_string t = t

     

       39
       39
       -
       let equal = String.equal

     

       40
       40
       -
       let compare = String.compare

     

       41
       41
       -
       let pp ppf t = Format.pp_print_string ppf t

     

       42
       42
       -
       

     

       43
       43
       -
       let jsont =

     

       44
       44
       -
         let kind = "Id" in

     

       45
       45
       -
         let dec s =

     

       46
       46
       -
           match validate s with

     

       47
       47
       -
           | Ok id -> id

     

       48
       48
       -
           | Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg

     

       49
       49
       -
         in

     

       50
       50
       -
         let enc t = t in

     

       51
       51
       -
         Jsont.map ~kind ~dec ~enc Jsont.string

-38

proto/id.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP identifier type.

     

       7
       7
       -
       

     

       8
       8
       -
           An Id is a string of 1-255 octets from the URL-safe base64 alphabet

     

       9
       9
       -
           (A-Za-z0-9_-), plus the ASCII alphanumeric characters.

     

       10
       10
       -
       

     

       11
       11
       -
           See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.2} RFC 8620 Section 1.2}. *)

     

       12
       12
       -
       

     

       13
       13
       -
       type t

     

       14
       14
       -
       (** The type of JMAP identifiers. *)

     

       15
       15
       -
       

     

       16
       16
       -
       val of_string : string -> (t, string) result

     

       17
       17
       -
       (** [of_string s] creates an Id from string [s].

     

       18
       18
       -
           Returns [Error msg] if [s] is empty, longer than 255 characters,

     

       19
       19
       -
           or contains invalid characters. *)

     

       20
       20
       -
       

     

       21
       21
       -
       val of_string_exn : string -> t

     

       22
       22
       -
       (** [of_string_exn s] creates an Id from string [s].

     

       23
       23
       -
           @raise Invalid_argument if the string is invalid. *)

     

       24
       24
       -
       

     

       25
       25
       -
       val to_string : t -> string

     

       26
       26
       -
       (** [to_string id] returns the string representation of [id]. *)

     

       27
       27
       -
       

     

       28
       28
       -
       val equal : t -> t -> bool

     

       29
       29
       -
       (** [equal a b] tests equality of identifiers. *)

     

       30
       30
       -
       

     

       31
       31
       -
       val compare : t -> t -> int

     

       32
       32
       -
       (** [compare a b] compares two identifiers. *)

     

       33
       33
       -
       

     

       34
       34
       -
       val pp : Format.formatter -> t -> unit

     

       35
       35
       -
       (** [pp ppf id] pretty-prints [id] to [ppf]. *)

     

       36
       36
       -
       

     

       37
       37
       -
       val jsont : t Jsont.t

     

       38
       38
       -
       (** JSON codec for JMAP identifiers. *)

-67

proto/int53.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JavaScript-safe integer types for JSON.

     

       7
       7
       -
       

     

       8
       8
       -
           These types represent integers that can be safely represented in JavaScript's

     

       9
       9
       -
           IEEE 754 double-precision floating point format without loss of precision. *)

     

       10
       10
       -
       

     

       11
       11
       -
       (** 53-bit signed integer with range -2^53+1 to 2^53-1 *)

     

       12
       12
       -
       module Signed = struct

     

       13
       13
       -
         type t = int64

     

       14
       14
       -
       

     

       15
       15
       -
         (* 2^53 - 1 *)

     

       16
       16
       -
         let max_value = 9007199254740991L

     

       17
       17
       -
         (* -(2^53 - 1) *)

     

       18
       18
       -
         let min_value = -9007199254740991L

     

       19
       19
       -
       

     

       20
       20
       -
         let of_int n = Int64.of_int n

     

       21
       21
       -
       

     

       22
       22
       -
         let to_int n =

     

       23
       23
       -
           if n >= Int64.of_int min_int && n <= Int64.of_int max_int then

     

       24
       24
       -
             Some (Int64.to_int n)

     

       25
       25
       -
           else

     

       26
       26
       -
             None

     

       27
       27
       -
       

     

       28
       28
       -
         let of_int64 n =

     

       29
       29
       -
           if n >= min_value && n <= max_value then Ok n

     

       30
       30
       -
           else Error (Printf.sprintf "Int53 out of range: %Ld" n)

     

       31
       31
       -
       

     

       32
       32
       -
         let jsont =

     

       33
       33
       -
           let kind = "Int53" in

     

       34
       34
       -
           let dec f =

     

       35
       35
       -
             let n = Int64.of_float f in

     

       36
       36
       -
             if n >= min_value && n <= max_value then n

     

       37
       37
       -
             else Jsont.Error.msgf Jsont.Meta.none "%s: value %Ld out of safe integer range" kind n

     

       38
       38
       -
           in

     

       39
       39
       -
           let enc n = Int64.to_float n in

     

       40
       40
       -
           Jsont.map ~kind ~dec ~enc Jsont.number

     

       41
       41
       -
       end

     

       42
       42
       -
       

     

       43
       43
       -
       (** 53-bit unsigned integer with range 0 to 2^53-1 *)

     

       44
       44
       -
       module Unsigned = struct

     

       45
       45
       -
         type t = int64

     

       46
       46
       -
       

     

       47
       47
       -
         let min_value = 0L

     

       48
       48
       -
         let max_value = 9007199254740991L

     

       49
       49
       -
       

     

       50
       50
       -
         let of_int n =

     

       51
       51
       -
           if n >= 0 then Ok (Int64.of_int n)

     

       52
       52
       -
           else Error "UnsignedInt53 cannot be negative"

     

       53
       53
       -
       

     

       54
       54
       -
         let of_int64 n =

     

       55
       55
       -
           if n >= min_value && n <= max_value then Ok n

     

       56
       56
       -
           else Error (Printf.sprintf "UnsignedInt53 out of range: %Ld" n)

     

       57
       57
       -
       

     

       58
       58
       -
         let jsont =

     

       59
       59
       -
           let kind = "UnsignedInt53" in

     

       60
       60
       -
           let dec f =

     

       61
       61
       -
             let n = Int64.of_float f in

     

       62
       62
       -
             if n >= min_value && n <= max_value then n

     

       63
       63
       -
             else Jsont.Error.msgf Jsont.Meta.none "%s: value %Ld out of range [0, 2^53-1]" kind n

     

       64
       64
       -
           in

     

       65
       65
       -
           let enc n = Int64.to_float n in

     

       66
       66
       -
           Jsont.map ~kind ~dec ~enc Jsont.number

     

       67
       67
       -
       end

-62

proto/int53.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JavaScript-safe integer types for JSON.

     

       7
       7
       -
       

     

       8
       8
       -
           These types represent integers that can be safely represented in JavaScript's

     

       9
       9
       -
           IEEE 754 double-precision floating point format without loss of precision.

     

       10
       10
       -
           The safe range is -2^53+1 to 2^53-1.

     

       11
       11
       -
       

     

       12
       12
       -
           See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.3} RFC 8620 Section 1.3}. *)

     

       13
       13
       -
       

     

       14
       14
       -
       (** 53-bit signed integer.

     

       15
       15
       -
       

     

       16
       16
       -
           The range is -2^53+1 to 2^53-1, which is the safe integer range

     

       17
       17
       -
           for JavaScript/JSON numbers. *)

     

       18
       18
       -
       module Signed : sig

     

       19
       19
       -
         type t = int64

     

       20
       20
       -
         (** The type of 53-bit signed integers. *)

     

       21
       21
       -
       

     

       22
       22
       -
         val min_value : t

     

       23
       23
       -
         (** Minimum value: -9007199254740991 (-2^53+1) *)

     

       24
       24
       -
       

     

       25
       25
       -
         val max_value : t

     

       26
       26
       -
         (** Maximum value: 9007199254740991 (2^53-1) *)

     

       27
       27
       -
       

     

       28
       28
       -
         val of_int : int -> t

     

       29
       29
       -
         (** [of_int n] converts an OCaml int to Int53. *)

     

       30
       30
       -
       

     

       31
       31
       -
         val to_int : t -> int option

     

       32
       32
       -
         (** [to_int n] converts to OCaml int if it fits. *)

     

       33
       33
       -
       

     

       34
       34
       -
         val of_int64 : int64 -> (t, string) result

     

       35
       35
       -
         (** [of_int64 n] validates that [n] is in the safe range. *)

     

       36
       36
       -
       

     

       37
       37
       -
         val jsont : t Jsont.t

     

       38
       38
       -
         (** JSON codec for 53-bit integers. Encoded as JSON number. *)

     

       39
       39
       -
       end

     

       40
       40
       -
       

     

       41
       41
       -
       (** 53-bit unsigned integer.

     

       42
       42
       -
       

     

       43
       43
       -
           The range is 0 to 2^53-1. *)

     

       44
       44
       -
       module Unsigned : sig

     

       45
       45
       -
         type t = int64

     

       46
       46
       -
         (** The type of 53-bit unsigned integers. *)

     

       47
       47
       -
       

     

       48
       48
       -
         val min_value : t

     

       49
       49
       -
         (** Minimum value: 0 *)

     

       50
       50
       -
       

     

       51
       51
       -
         val max_value : t

     

       52
       52
       -
         (** Maximum value: 9007199254740991 (2^53-1) *)

     

       53
       53
       -
       

     

       54
       54
       -
         val of_int : int -> (t, string) result

     

       55
       55
       -
         (** [of_int n] converts an OCaml int to UnsignedInt53. *)

     

       56
       56
       -
       

     

       57
       57
       -
         val of_int64 : int64 -> (t, string) result

     

       58
       58
       -
         (** [of_int64 n] validates that [n] is in the valid range. *)

     

       59
       59
       -
       

     

       60
       60
       -
         val jsont : t Jsont.t

     

       61
       61
       -
         (** JSON codec for 53-bit unsigned integers. *)

     

       62
       62
       -
       end

-86

proto/invocation.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type result_reference = {

     

       7
       7
       -
         result_of : string;

     

       8
       8
       -
         name : string;

     

       9
       9
       -
         path : string;

     

       10
       10
       -
       }

     

       11
       11
       -
       

     

       12
       12
       -
       let result_reference ~result_of ~name ~path =

     

       13
       13
       -
         { result_of; name; path }

     

       14
       14
       -
       

     

       15
       15
       -
       let result_reference_make result_of name path =

     

       16
       16
       -
         { result_of; name; path }

     

       17
       17
       -
       

     

       18
       18
       -
       let result_reference_jsont =

     

       19
       19
       -
         let kind = "ResultReference" in

     

       20
       20
       -
         Jsont.Object.map ~kind result_reference_make

     

       21
       21
       -
         |> Jsont.Object.mem "resultOf" Jsont.string ~enc:(fun r -> r.result_of)

     

       22
       22
       -
         |> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)

     

       23
       23
       -
         |> Jsont.Object.mem "path" Jsont.string ~enc:(fun r -> r.path)

     

       24
       24
       -
         |> Jsont.Object.finish

     

       25
       25
       -
       

     

       26
       26
       -
       type t = {

     

       27
       27
       -
         name : string;

     

       28
       28
       -
         arguments : Jsont.json;

     

       29
       29
       -
         method_call_id : string;

     

       30
       30
       -
       }

     

       31
       31
       -
       

     

       32
       32
       -
       let create ~name ~arguments ~method_call_id =

     

       33
       33
       -
         { name; arguments; method_call_id }

     

       34
       34
       -
       

     

       35
       35
       -
       let name t = t.name

     

       36
       36
       -
       let arguments t = t.arguments

     

       37
       37
       -
       let method_call_id t = t.method_call_id

     

       38
       38
       -
       

     

       39
       39
       -
       (* Helper to encode a typed value back to Jsont.json *)

     

       40
       40
       -
       let encode_json_value jsont value =

     

       41
       41
       -
         match Jsont.Json.encode' jsont value with

     

       42
       42
       -
         | Ok json -> json

     

       43
       43
       -
         | Error _ -> Jsont.Object ([], Jsont.Meta.none)

     

       44
       44
       -
       

     

       45
       45
       -
       let jsont =

     

       46
       46
       -
         let kind = "Invocation" in

     

       47
       47
       -
         (* Invocation is [name, args, callId] - a 3-element heterogeneous array *)

     

       48
       48
       -
         (* We need to handle this as a json array since elements have different types *)

     

       49
       49
       -
         let dec json =

     

       50
       50
       -
           match json with

     

       51
       51
       -
           | Jsont.Array ([name_json; arguments; call_id_json], _) ->

     

       52
       52
       -
             let name = match name_json with

     

       53
       53
       -
               | Jsont.String (s, _) -> s

     

       54
       54
       -
               | _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[0] must be a string"

     

       55
       55
       -
             in

     

       56
       56
       -
             let method_call_id = match call_id_json with

     

       57
       57
       -
               | Jsont.String (s, _) -> s

     

       58
       58
       -
               | _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[2] must be a string"

     

       59
       59
       -
             in

     

       60
       60
       -
             { name; arguments; method_call_id }

     

       61
       61
       -
           | Jsont.Array _ ->

     

       62
       62
       -
             Jsont.Error.msg Jsont.Meta.none "Invocation must be a 3-element array"

     

       63
       63
       -
           | _ ->

     

       64
       64
       -
             Jsont.Error.msg Jsont.Meta.none "Invocation must be an array"

     

       65
       65
       -
         in

     

       66
       66
       -
         let enc t =

     

       67
       67
       -
           Jsont.Array ([

     

       68
       68
       -
             Jsont.String (t.name, Jsont.Meta.none);

     

       69
       69
       -
             t.arguments;

     

       70
       70
       -
             Jsont.String (t.method_call_id, Jsont.Meta.none);

     

       71
       71
       -
           ], Jsont.Meta.none)

     

       72
       72
       -
         in

     

       73
       73
       -
         Jsont.map ~kind ~dec ~enc Jsont.json

     

       74
       74
       -
       

     

       75
       75
       -
       let make_get ~method_call_id ~method_name args =

     

       76
       76
       -
         let arguments = encode_json_value Method_.get_args_jsont args in

     

       77
       77
       -
         { name = method_name; arguments; method_call_id }

     

       78
       78
       -
       

     

       79
       79
       -
       let make_changes ~method_call_id ~method_name args =

     

       80
       80
       -
         let arguments = encode_json_value Method_.changes_args_jsont args in

     

       81
       81
       -
         { name = method_name; arguments; method_call_id }

     

       82
       82
       -
       

     

       83
       83
       -
       let make_query (type f) ~method_call_id ~method_name

     

       84
       84
       -
           ~(filter_cond_jsont : f Jsont.t) (args : f Method_.query_args) =

     

       85
       85
       -
         let arguments = encode_json_value (Method_.query_args_jsont filter_cond_jsont) args in

     

       86
       86
       -
         { name = method_name; arguments; method_call_id }

-81

proto/invocation.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP method invocation as defined in RFC 8620 Section 3.2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Result References} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** A reference to a result from a previous method call.

     

       11
       11
       -
       

     

       12
       12
       -
           Used for back-referencing values within a single request. *)

     

       13
       13
       -
       type result_reference = {

     

       14
       14
       -
         result_of : string;

     

       15
       15
       -
         (** The method call id to reference. *)

     

       16
       16
       -
         name : string;

     

       17
       17
       -
         (** The method name that was called. *)

     

       18
       18
       -
         path : string;

     

       19
       19
       -
         (** A JSON Pointer to the value within the result. *)

     

       20
       20
       -
       }

     

       21
       21
       -
       

     

       22
       22
       -
       val result_reference :

     

       23
       23
       -
         result_of:string ->

     

       24
       24
       -
         name:string ->

     

       25
       25
       -
         path:string ->

     

       26
       26
       -
         result_reference

     

       27
       27
       -
       

     

       28
       28
       -
       val result_reference_jsont : result_reference Jsont.t

     

       29
       29
       -
       

     

       30
       30
       -
       (** {1 Invocations} *)

     

       31
       31
       -
       

     

       32
       32
       -
       (** A method invocation.

     

       33
       33
       -
       

     

       34
       34
       -
           In JSON, this is represented as a 3-element array:

     

       35
       35
       -
           ["methodName", {args}, "methodCallId"] *)

     

       36
       36
       -
       type t = {

     

       37
       37
       -
         name : string;

     

       38
       38
       -
         (** The method name, e.g., "Email/get". *)

     

       39
       39
       -
         arguments : Jsont.json;

     

       40
       40
       -
         (** The method arguments as a JSON object. *)

     

       41
       41
       -
         method_call_id : string;

     

       42
       42
       -
         (** Client-specified identifier for this call. *)

     

       43
       43
       -
       }

     

       44
       44
       -
       

     

       45
       45
       -
       val create :

     

       46
       46
       -
         name:string ->

     

       47
       47
       -
         arguments:Jsont.json ->

     

       48
       48
       -
         method_call_id:string ->

     

       49
       49
       -
         t

     

       50
       50
       -
       (** [create ~name ~arguments ~method_call_id] creates an invocation. *)

     

       51
       51
       -
       

     

       52
       52
       -
       val name : t -> string

     

       53
       53
       -
       val arguments : t -> Jsont.json

     

       54
       54
       -
       val method_call_id : t -> string

     

       55
       55
       -
       

     

       56
       56
       -
       val jsont : t Jsont.t

     

       57
       57
       -
       (** JSON codec for invocations (as 3-element array). *)

     

       58
       58
       -
       

     

       59
       59
       -
       (** {1 Typed Invocation Helpers} *)

     

       60
       60
       -
       

     

       61
       61
       -
       val make_get :

     

       62
       62
       -
         method_call_id:string ->

     

       63
       63
       -
         method_name:string ->

     

       64
       64
       -
         Method_.get_args ->

     

       65
       65
       -
         t

     

       66
       66
       -
       (** [make_get ~method_call_id ~method_name args] creates a /get invocation. *)

     

       67
       67
       -
       

     

       68
       68
       -
       val make_changes :

     

       69
       69
       -
         method_call_id:string ->

     

       70
       70
       -
         method_name:string ->

     

       71
       71
       -
         Method_.changes_args ->

     

       72
       72
       -
         t

     

       73
       73
       -
       (** [make_changes ~method_call_id ~method_name args] creates a /changes invocation. *)

     

       74
       74
       -
       

     

       75
       75
       -
       val make_query :

     

       76
       76
       -
         method_call_id:string ->

     

       77
       77
       -
         method_name:string ->

     

       78
       78
       -
         filter_cond_jsont:'f Jsont.t ->

     

       79
       79
       -
         'f Method_.query_args ->

     

       80
       80
       -
         t

     

       81
       81
       -
       (** [make_query ~method_call_id ~method_name ~filter_cond_jsont args] creates a /query invocation. *)

-24

proto/jmap_proto.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP Protocol Types (RFC 8620)

     

       7
       7
       -
       

     

       8
       8
       -
           This module re-exports all JMAP core protocol types. *)

     

       9
       9
       -
       

     

       10
       10
       -
       module Id = Id

     

       11
       11
       -
       module Int53 = Int53

     

       12
       12
       -
       module Date = Date

     

       13
       13
       -
       module Json_map = Json_map

     

       14
       14
       -
       module Unknown = Unknown

     

       15
       15
       -
       module Error = Error

     

       16
       16
       -
       module Capability = Capability

     

       17
       17
       -
       module Filter = Filter

     

       18
       18
       -
       module Method = Method_

     

       19
       19
       -
       module Invocation = Invocation

     

       20
       20
       -
       module Request = Request

     

       21
       21
       -
       module Response = Response

     

       22
       22
       -
       module Session = Session

     

       23
       23
       -
       module Push = Push

     

       24
       24
       -
       module Blob = Blob

-40

proto/json_map.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JSON object-as-map codec utilities.

     

       7
       7
       -
       

     

       8
       8
       -
           JMAP frequently uses JSON objects as maps with string or Id keys.

     

       9
       9
       -
           These codecs convert between JSON objects and OCaml association lists. *)

     

       10
       10
       -
       

     

       11
       11
       -
       module String_map = Map.Make(String)

     

       12
       12
       -
       

     

       13
       13
       -
       let of_string value_jsont =

     

       14
       14
       -
         let kind = "String map" in

     

       15
       15
       -
         Jsont.Object.map ~kind Fun.id

     

       16
       16
       -
         |> Jsont.Object.keep_unknown (Jsont.Object.Mems.string_map value_jsont) ~enc:Fun.id

     

       17
       17
       -
         |> Jsont.Object.finish

     

       18
       18
       -
         |> Jsont.map

     

       19
       19
       -
           ~dec:(fun m -> List.of_seq (String_map.to_seq m))

     

       20
       20
       -
           ~enc:(fun l -> String_map.of_list l)

     

       21
       21
       -
       

     

       22
       22
       -
       let of_id value_jsont =

     

       23
       23
       -
         let kind = "Id map" in

     

       24
       24
       -
         (* Use string map internally, then convert keys to Ids *)

     

       25
       25
       -
         let string_codec = of_string value_jsont in

     

       26
       26
       -
         let dec pairs =

     

       27
       27
       -
           List.map (fun (k, v) ->

     

       28
       28
       -
             match Id.of_string k with

     

       29
       29
       -
             | Ok id -> (id, v)

     

       30
       30
       -
             | Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: invalid key %s - %s" kind k msg

     

       31
       31
       -
           ) pairs

     

       32
       32
       -
         in

     

       33
       33
       -
         let enc pairs =

     

       34
       34
       -
           List.map (fun (id, v) -> (Id.to_string id, v)) pairs

     

       35
       35
       -
         in

     

       36
       36
       -
         Jsont.map ~kind ~dec ~enc string_codec

     

       37
       37
       -
       

     

       38
       38
       -
       let id_to_bool = of_id Jsont.bool

     

       39
       39
       -
       

     

       40
       40
       -
       let string_to_bool = of_string Jsont.bool

-23

proto/json_map.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JSON object-as-map codec utilities.

     

       7
       7
       -
       

     

       8
       8
       -
           JMAP frequently uses JSON objects as maps with string or Id keys.

     

       9
       9
       -
           These codecs convert between JSON objects and OCaml association lists. *)

     

       10
       10
       -
       

     

       11
       11
       -
       val of_string : 'a Jsont.t -> (string * 'a) list Jsont.t

     

       12
       12
       -
       (** [of_string value_jsont] creates a codec for JSON objects

     

       13
       13
       -
           used as string-keyed maps. Returns an association list. *)

     

       14
       14
       -
       

     

       15
       15
       -
       val of_id : 'a Jsont.t -> (Id.t * 'a) list Jsont.t

     

       16
       16
       -
       (** [of_id value_jsont] creates a codec for JSON objects

     

       17
       17
       -
           keyed by JMAP identifiers. *)

     

       18
       18
       -
       

     

       19
       19
       -
       val id_to_bool : (Id.t * bool) list Jsont.t

     

       20
       20
       -
       (** Codec for Id[Boolean] maps, common in JMAP (e.g., mailboxIds, keywords). *)

     

       21
       21
       -
       

     

       22
       22
       -
       val string_to_bool : (string * bool) list Jsont.t

     

       23
       23
       -
       (** Codec for String[Boolean] maps. *)

-17

proto/mail/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name jmap_mail)

     

       3
       3
       -
        (public_name jmap.mail)

     

       4
       4
       -
        (libraries jmap jsont ptime)

     

       5
       5
       -
        (modules

     

       6
       6
       -
         jmap_mail

     

       7
       7
       -
         email_address

     

       8
       8
       -
         email_header

     

       9
       9
       -
         email_body

     

       10
       10
       -
         mailbox

     

       11
       11
       -
         thread

     

       12
       12
       -
         email

     

       13
       13
       -
         search_snippet

     

       14
       14
       -
         identity

     

       15
       15
       -
         submission

     

       16
       16
       -
         vacation

     

       17
       17
       -
         mail_filter))

-216

proto/mail/email.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Keyword = struct

     

       7
       7
       -
         let draft = "$draft"

     

       8
       8
       -
         let seen = "$seen"

     

       9
       9
       -
         let flagged = "$flagged"

     

       10
       10
       -
         let answered = "$answered"

     

       11
       11
       -
         let forwarded = "$forwarded"

     

       12
       12
       -
         let phishing = "$phishing"

     

       13
       13
       -
         let junk = "$junk"

     

       14
       14
       -
         let not_junk = "$notjunk"

     

       15
       15
       -
       end

     

       16
       16
       -
       

     

       17
       17
       -
       type t = {

     

       18
       18
       -
         id : Jmap_proto.Id.t;

     

       19
       19
       -
         blob_id : Jmap_proto.Id.t;

     

       20
       20
       -
         thread_id : Jmap_proto.Id.t;

     

       21
       21
       -
         size : int64;

     

       22
       22
       -
         received_at : Ptime.t;

     

       23
       23
       -
         mailbox_ids : (Jmap_proto.Id.t * bool) list;

     

       24
       24
       -
         keywords : (string * bool) list;

     

       25
       25
       -
         message_id : string list option;

     

       26
       26
       -
         in_reply_to : string list option;

     

       27
       27
       -
         references : string list option;

     

       28
       28
       -
         sender : Email_address.t list option;

     

       29
       29
       -
         from : Email_address.t list option;

     

       30
       30
       -
         to_ : Email_address.t list option;

     

       31
       31
       -
         cc : Email_address.t list option;

     

       32
       32
       -
         bcc : Email_address.t list option;

     

       33
       33
       -
         reply_to : Email_address.t list option;

     

       34
       34
       -
         subject : string option;

     

       35
       35
       -
         sent_at : Ptime.t option;

     

       36
       36
       -
         headers : Email_header.t list option;

     

       37
       37
       -
         body_structure : Email_body.Part.t option;

     

       38
       38
       -
         body_values : (string * Email_body.Value.t) list option;

     

       39
       39
       -
         text_body : Email_body.Part.t list option;

     

       40
       40
       -
         html_body : Email_body.Part.t list option;

     

       41
       41
       -
         attachments : Email_body.Part.t list option;

     

       42
       42
       -
         has_attachment : bool;

     

       43
       43
       -
         preview : string;

     

       44
       44
       -
       }

     

       45
       45
       -
       

     

       46
       46
       -
       let id t = t.id

     

       47
       47
       -
       let blob_id t = t.blob_id

     

       48
       48
       -
       let thread_id t = t.thread_id

     

       49
       49
       -
       let size t = t.size

     

       50
       50
       -
       let received_at t = t.received_at

     

       51
       51
       -
       let mailbox_ids t = t.mailbox_ids

     

       52
       52
       -
       let keywords t = t.keywords

     

       53
       53
       -
       let message_id t = t.message_id

     

       54
       54
       -
       let in_reply_to t = t.in_reply_to

     

       55
       55
       -
       let references t = t.references

     

       56
       56
       -
       let sender t = t.sender

     

       57
       57
       -
       let from t = t.from

     

       58
       58
       -
       let to_ t = t.to_

     

       59
       59
       -
       let cc t = t.cc

     

       60
       60
       -
       let bcc t = t.bcc

     

       61
       61
       -
       let reply_to t = t.reply_to

     

       62
       62
       -
       let subject t = t.subject

     

       63
       63
       -
       let sent_at t = t.sent_at

     

       64
       64
       -
       let headers t = t.headers

     

       65
       65
       -
       let body_structure t = t.body_structure

     

       66
       66
       -
       let body_values t = t.body_values

     

       67
       67
       -
       let text_body t = t.text_body

     

       68
       68
       -
       let html_body t = t.html_body

     

       69
       69
       -
       let attachments t = t.attachments

     

       70
       70
       -
       let has_attachment t = t.has_attachment

     

       71
       71
       -
       let preview t = t.preview

     

       72
       72
       -
       

     

       73
       73
       -
       let make id blob_id thread_id size received_at mailbox_ids keywords

     

       74
       74
       -
           message_id in_reply_to references sender from to_ cc bcc reply_to

     

       75
       75
       -
           subject sent_at headers body_structure body_values text_body html_body

     

       76
       76
       -
           attachments has_attachment preview =

     

       77
       77
       -
         { id; blob_id; thread_id; size; received_at; mailbox_ids; keywords;

     

       78
       78
       -
           message_id; in_reply_to; references; sender; from; to_; cc; bcc;

     

       79
       79
       -
           reply_to; subject; sent_at; headers; body_structure; body_values;

     

       80
       80
       -
           text_body; html_body; attachments; has_attachment; preview }

     

       81
       81
       -
       

     

       82
       82
       -
       let jsont =

     

       83
       83
       -
         let kind = "Email" in

     

       84
       84
       -
         let body_values_jsont = Jmap_proto.Json_map.of_string Email_body.Value.jsont in

     

       85
       85
       -
         Jsont.Object.map ~kind make

     

       86
       86
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       87
       87
       -
         |> Jsont.Object.mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id

     

       88
       88
       -
         |> Jsont.Object.mem "threadId" Jmap_proto.Id.jsont ~enc:thread_id

     

       89
       89
       -
         |> Jsont.Object.mem "size" Jmap_proto.Int53.Unsigned.jsont ~enc:size

     

       90
       90
       -
         |> Jsont.Object.mem "receivedAt" Jmap_proto.Date.Utc.jsont ~enc:received_at

     

       91
       91
       -
         |> Jsont.Object.mem "mailboxIds" Jmap_proto.Json_map.id_to_bool ~enc:mailbox_ids

     

       92
       92
       -
         |> Jsont.Object.mem "keywords" Jmap_proto.Json_map.string_to_bool ~dec_absent:[] ~enc:keywords

     

       93
       93
       -
         |> Jsont.Object.opt_mem "messageId" (Jsont.list Jsont.string) ~enc:message_id

     

       94
       94
       -
         |> Jsont.Object.opt_mem "inReplyTo" (Jsont.list Jsont.string) ~enc:in_reply_to

     

       95
       95
       -
         |> Jsont.Object.opt_mem "references" (Jsont.list Jsont.string) ~enc:references

     

       96
       96
       -
         |> Jsont.Object.opt_mem "sender" (Jsont.list Email_address.jsont) ~enc:sender

     

       97
       97
       -
         |> Jsont.Object.opt_mem "from" (Jsont.list Email_address.jsont) ~enc:from

     

       98
       98
       -
         |> Jsont.Object.opt_mem "to" (Jsont.list Email_address.jsont) ~enc:to_

     

       99
       99
       -
         |> Jsont.Object.opt_mem "cc" (Jsont.list Email_address.jsont) ~enc:cc

     

       100
       100
       -
         |> Jsont.Object.opt_mem "bcc" (Jsont.list Email_address.jsont) ~enc:bcc

     

       101
       101
       -
         |> Jsont.Object.opt_mem "replyTo" (Jsont.list Email_address.jsont) ~enc:reply_to

     

       102
       102
       -
         |> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject

     

       103
       103
       -
         |> Jsont.Object.opt_mem "sentAt" Jmap_proto.Date.Rfc3339.jsont ~enc:sent_at

     

       104
       104
       -
         |> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers

     

       105
       105
       -
         |> Jsont.Object.opt_mem "bodyStructure" Email_body.Part.jsont ~enc:body_structure

     

       106
       106
       -
         |> Jsont.Object.opt_mem "bodyValues" body_values_jsont ~enc:body_values

     

       107
       107
       -
         |> Jsont.Object.opt_mem "textBody" (Jsont.list Email_body.Part.jsont) ~enc:text_body

     

       108
       108
       -
         |> Jsont.Object.opt_mem "htmlBody" (Jsont.list Email_body.Part.jsont) ~enc:html_body

     

       109
       109
       -
         |> Jsont.Object.opt_mem "attachments" (Jsont.list Email_body.Part.jsont) ~enc:attachments

     

       110
       110
       -
         |> Jsont.Object.mem "hasAttachment" Jsont.bool ~dec_absent:false ~enc:has_attachment

     

       111
       111
       -
         |> Jsont.Object.mem "preview" Jsont.string ~dec_absent:"" ~enc:preview

     

       112
       112
       -
         |> Jsont.Object.finish

     

       113
       113
       -
       

     

       114
       114
       -
       module Filter_condition = struct

     

       115
       115
       -
         type t = {

     

       116
       116
       -
           in_mailbox : Jmap_proto.Id.t option;

     

       117
       117
       -
           in_mailbox_other_than : Jmap_proto.Id.t list option;

     

       118
       118
       -
           before : Ptime.t option;

     

       119
       119
       -
           after : Ptime.t option;

     

       120
       120
       -
           min_size : int64 option;

     

       121
       121
       -
           max_size : int64 option;

     

       122
       122
       -
           all_in_thread_have_keyword : string option;

     

       123
       123
       -
           some_in_thread_have_keyword : string option;

     

       124
       124
       -
           none_in_thread_have_keyword : string option;

     

       125
       125
       -
           has_keyword : string option;

     

       126
       126
       -
           not_keyword : string option;

     

       127
       127
       -
           has_attachment : bool option;

     

       128
       128
       -
           text : string option;

     

       129
       129
       -
           from : string option;

     

       130
       130
       -
           to_ : string option;

     

       131
       131
       -
           cc : string option;

     

       132
       132
       -
           bcc : string option;

     

       133
       133
       -
           subject : string option;

     

       134
       134
       -
           body : string option;

     

       135
       135
       -
           header : (string * string option) option;

     

       136
       136
       -
         }

     

       137
       137
       -
       

     

       138
       138
       -
         let make in_mailbox in_mailbox_other_than before after min_size max_size

     

       139
       139
       -
             all_in_thread_have_keyword some_in_thread_have_keyword

     

       140
       140
       -
             none_in_thread_have_keyword has_keyword not_keyword has_attachment

     

       141
       141
       -
             text from to_ cc bcc subject body header =

     

       142
       142
       -
           { in_mailbox; in_mailbox_other_than; before; after; min_size; max_size;

     

       143
       143
       -
             all_in_thread_have_keyword; some_in_thread_have_keyword;

     

       144
       144
       -
             none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;

     

       145
       145
       -
             text; from; to_; cc; bcc; subject; body; header }

     

       146
       146
       -
       

     

       147
       147
       -
         (* Header filter is encoded as [name] or [name, value] array *)

     

       148
       148
       -
         let header_jsont =

     

       149
       149
       -
           let kind = "HeaderFilter" in

     

       150
       150
       -
           let dec json =

     

       151
       151
       -
             match json with

     

       152
       152
       -
             | Jsont.Array ([Jsont.String (name, _)], _) ->

     

       153
       153
       -
               (name, None)

     

       154
       154
       -
             | Jsont.Array ([Jsont.String (name, _); Jsont.String (value, _)], _) ->

     

       155
       155
       -
               (name, Some value)

     

       156
       156
       -
             | _ ->

     

       157
       157
       -
               Jsont.Error.msgf Jsont.Meta.none "%s: expected [name] or [name, value]" kind

     

       158
       158
       -
           in

     

       159
       159
       -
           let enc (name, value) =

     

       160
       160
       -
             match value with

     

       161
       161
       -
             | None -> Jsont.Array ([Jsont.String (name, Jsont.Meta.none)], Jsont.Meta.none)

     

       162
       162
       -
             | Some v -> Jsont.Array ([Jsont.String (name, Jsont.Meta.none); Jsont.String (v, Jsont.Meta.none)], Jsont.Meta.none)

     

       163
       163
       -
           in

     

       164
       164
       -
           Jsont.map ~kind ~dec ~enc Jsont.json

     

       165
       165
       -
       

     

       166
       166
       -
         let jsont =

     

       167
       167
       -
           let kind = "EmailFilterCondition" in

     

       168
       168
       -
           Jsont.Object.map ~kind make

     

       169
       169
       -
           |> Jsont.Object.opt_mem "inMailbox" Jmap_proto.Id.jsont ~enc:(fun f -> f.in_mailbox)

     

       170
       170
       -
           |> Jsont.Object.opt_mem "inMailboxOtherThan" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.in_mailbox_other_than)

     

       171
       171
       -
           |> Jsont.Object.opt_mem "before" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.before)

     

       172
       172
       -
           |> Jsont.Object.opt_mem "after" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.after)

     

       173
       173
       -
           |> Jsont.Object.opt_mem "minSize" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun f -> f.min_size)

     

       174
       174
       -
           |> Jsont.Object.opt_mem "maxSize" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun f -> f.max_size)

     

       175
       175
       -
           |> Jsont.Object.opt_mem "allInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.all_in_thread_have_keyword)

     

       176
       176
       -
           |> Jsont.Object.opt_mem "someInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.some_in_thread_have_keyword)

     

       177
       177
       -
           |> Jsont.Object.opt_mem "noneInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.none_in_thread_have_keyword)

     

       178
       178
       -
           |> Jsont.Object.opt_mem "hasKeyword" Jsont.string ~enc:(fun f -> f.has_keyword)

     

       179
       179
       -
           |> Jsont.Object.opt_mem "notKeyword" Jsont.string ~enc:(fun f -> f.not_keyword)

     

       180
       180
       -
           |> Jsont.Object.opt_mem "hasAttachment" Jsont.bool ~enc:(fun f -> f.has_attachment)

     

       181
       181
       -
           |> Jsont.Object.opt_mem "text" Jsont.string ~enc:(fun f -> f.text)

     

       182
       182
       -
           |> Jsont.Object.opt_mem "from" Jsont.string ~enc:(fun f -> f.from)

     

       183
       183
       -
           |> Jsont.Object.opt_mem "to" Jsont.string ~enc:(fun f -> f.to_)

     

       184
       184
       -
           |> Jsont.Object.opt_mem "cc" Jsont.string ~enc:(fun f -> f.cc)

     

       185
       185
       -
           |> Jsont.Object.opt_mem "bcc" Jsont.string ~enc:(fun f -> f.bcc)

     

       186
       186
       -
           |> Jsont.Object.opt_mem "subject" Jsont.string ~enc:(fun f -> f.subject)

     

       187
       187
       -
           |> Jsont.Object.opt_mem "body" Jsont.string ~enc:(fun f -> f.body)

     

       188
       188
       -
           |> Jsont.Object.opt_mem "header" header_jsont ~enc:(fun f -> f.header)

     

       189
       189
       -
           |> Jsont.Object.finish

     

       190
       190
       -
       end

     

       191
       191
       -
       

     

       192
       192
       -
       type get_args_extra = {

     

       193
       193
       -
         body_properties : string list option;

     

       194
       194
       -
         fetch_text_body_values : bool;

     

       195
       195
       -
         fetch_html_body_values : bool;

     

       196
       196
       -
         fetch_all_body_values : bool;

     

       197
       197
       -
         max_body_value_bytes : int64 option;

     

       198
       198
       -
       }

     

       199
       199
       -
       

     

       200
       200
       -
       let get_args_extra_make body_properties fetch_text_body_values

     

       201
       201
       -
           fetch_html_body_values fetch_all_body_values max_body_value_bytes =

     

       202
       202
       -
         { body_properties; fetch_text_body_values; fetch_html_body_values;

     

       203
       203
       -
           fetch_all_body_values; max_body_value_bytes }

     

       204
       204
       -
       

     

       205
       205
       -
       let get_args_extra_jsont =

     

       206
       206
       -
         let kind = "Email/get extra args" in

     

       207
       207
       -
         Jsont.Object.map ~kind get_args_extra_make

     

       208
       208
       -
         |> Jsont.Object.opt_mem "bodyProperties" (Jsont.list Jsont.string) ~enc:(fun a -> a.body_properties)

     

       209
       209
       -
         |> Jsont.Object.mem "fetchTextBodyValues" Jsont.bool ~dec_absent:false

     

       210
       210
       -
              ~enc:(fun a -> a.fetch_text_body_values) ~enc_omit:(fun b -> not b)

     

       211
       211
       -
         |> Jsont.Object.mem "fetchHTMLBodyValues" Jsont.bool ~dec_absent:false

     

       212
       212
       -
              ~enc:(fun a -> a.fetch_html_body_values) ~enc_omit:(fun b -> not b)

     

       213
       213
       -
         |> Jsont.Object.mem "fetchAllBodyValues" Jsont.bool ~dec_absent:false

     

       214
       214
       -
              ~enc:(fun a -> a.fetch_all_body_values) ~enc_omit:(fun b -> not b)

     

       215
       215
       -
         |> Jsont.Object.opt_mem "maxBodyValueBytes" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun a -> a.max_body_value_bytes)

     

       216
       216
       -
         |> Jsont.Object.finish

-146

proto/mail/email.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Email type as defined in RFC 8621 Section 4 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Standard Keywords} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Standard email keywords per RFC 8621. *)

     

       11
       11
       -
       module Keyword : sig

     

       12
       12
       -
         val draft : string

     

       13
       13
       -
         (** ["$draft"] *)

     

       14
       14
       -
       

     

       15
       15
       -
         val seen : string

     

       16
       16
       -
         (** ["$seen"] *)

     

       17
       17
       -
       

     

       18
       18
       -
         val flagged : string

     

       19
       19
       -
         (** ["$flagged"] *)

     

       20
       20
       -
       

     

       21
       21
       -
         val answered : string

     

       22
       22
       -
         (** ["$answered"] *)

     

       23
       23
       -
       

     

       24
       24
       -
         val forwarded : string

     

       25
       25
       -
         (** ["$forwarded"] *)

     

       26
       26
       -
       

     

       27
       27
       -
         val phishing : string

     

       28
       28
       -
         (** ["$phishing"] *)

     

       29
       29
       -
       

     

       30
       30
       -
         val junk : string

     

       31
       31
       -
         (** ["$junk"] *)

     

       32
       32
       -
       

     

       33
       33
       -
         val not_junk : string

     

       34
       34
       -
         (** ["$notjunk"] *)

     

       35
       35
       -
       end

     

       36
       36
       -
       

     

       37
       37
       -
       (** {1 Email Object} *)

     

       38
       38
       -
       

     

       39
       39
       -
       type t = {

     

       40
       40
       -
         (* Metadata - server-set, immutable *)

     

       41
       41
       -
         id : Jmap_proto.Id.t;

     

       42
       42
       -
         blob_id : Jmap_proto.Id.t;

     

       43
       43
       -
         thread_id : Jmap_proto.Id.t;

     

       44
       44
       -
         size : int64;

     

       45
       45
       -
         received_at : Ptime.t;

     

       46
       46
       -
       

     

       47
       47
       -
         (* Metadata - mutable *)

     

       48
       48
       -
         mailbox_ids : (Jmap_proto.Id.t * bool) list;

     

       49
       49
       -
         keywords : (string * bool) list;

     

       50
       50
       -
       

     

       51
       51
       -
         (* Parsed headers *)

     

       52
       52
       -
         message_id : string list option;

     

       53
       53
       -
         in_reply_to : string list option;

     

       54
       54
       -
         references : string list option;

     

       55
       55
       -
         sender : Email_address.t list option;

     

       56
       56
       -
         from : Email_address.t list option;

     

       57
       57
       -
         to_ : Email_address.t list option;

     

       58
       58
       -
         cc : Email_address.t list option;

     

       59
       59
       -
         bcc : Email_address.t list option;

     

       60
       60
       -
         reply_to : Email_address.t list option;

     

       61
       61
       -
         subject : string option;

     

       62
       62
       -
         sent_at : Ptime.t option;

     

       63
       63
       -
       

     

       64
       64
       -
         (* Raw headers *)

     

       65
       65
       -
         headers : Email_header.t list option;

     

       66
       66
       -
       

     

       67
       67
       -
         (* Body structure *)

     

       68
       68
       -
         body_structure : Email_body.Part.t option;

     

       69
       69
       -
         body_values : (string * Email_body.Value.t) list option;

     

       70
       70
       -
         text_body : Email_body.Part.t list option;

     

       71
       71
       -
         html_body : Email_body.Part.t list option;

     

       72
       72
       -
         attachments : Email_body.Part.t list option;

     

       73
       73
       -
         has_attachment : bool;

     

       74
       74
       -
         preview : string;

     

       75
       75
       -
       }

     

       76
       76
       -
       

     

       77
       77
       -
       val id : t -> Jmap_proto.Id.t

     

       78
       78
       -
       val blob_id : t -> Jmap_proto.Id.t

     

       79
       79
       -
       val thread_id : t -> Jmap_proto.Id.t

     

       80
       80
       -
       val size : t -> int64

     

       81
       81
       -
       val received_at : t -> Ptime.t

     

       82
       82
       -
       val mailbox_ids : t -> (Jmap_proto.Id.t * bool) list

     

       83
       83
       -
       val keywords : t -> (string * bool) list

     

       84
       84
       -
       val message_id : t -> string list option

     

       85
       85
       -
       val in_reply_to : t -> string list option

     

       86
       86
       -
       val references : t -> string list option

     

       87
       87
       -
       val sender : t -> Email_address.t list option

     

       88
       88
       -
       val from : t -> Email_address.t list option

     

       89
       89
       -
       val to_ : t -> Email_address.t list option

     

       90
       90
       -
       val cc : t -> Email_address.t list option

     

       91
       91
       -
       val bcc : t -> Email_address.t list option

     

       92
       92
       -
       val reply_to : t -> Email_address.t list option

     

       93
       93
       -
       val subject : t -> string option

     

       94
       94
       -
       val sent_at : t -> Ptime.t option

     

       95
       95
       -
       val headers : t -> Email_header.t list option

     

       96
       96
       -
       val body_structure : t -> Email_body.Part.t option

     

       97
       97
       -
       val body_values : t -> (string * Email_body.Value.t) list option

     

       98
       98
       -
       val text_body : t -> Email_body.Part.t list option

     

       99
       99
       -
       val html_body : t -> Email_body.Part.t list option

     

       100
       100
       -
       val attachments : t -> Email_body.Part.t list option

     

       101
       101
       -
       val has_attachment : t -> bool

     

       102
       102
       -
       val preview : t -> string

     

       103
       103
       -
       

     

       104
       104
       -
       val jsont : t Jsont.t

     

       105
       105
       -
       

     

       106
       106
       -
       (** {1 Email Filter Conditions} *)

     

       107
       107
       -
       

     

       108
       108
       -
       module Filter_condition : sig

     

       109
       109
       -
         type t = {

     

       110
       110
       -
           in_mailbox : Jmap_proto.Id.t option;

     

       111
       111
       -
           in_mailbox_other_than : Jmap_proto.Id.t list option;

     

       112
       112
       -
           before : Ptime.t option;

     

       113
       113
       -
           after : Ptime.t option;

     

       114
       114
       -
           min_size : int64 option;

     

       115
       115
       -
           max_size : int64 option;

     

       116
       116
       -
           all_in_thread_have_keyword : string option;

     

       117
       117
       -
           some_in_thread_have_keyword : string option;

     

       118
       118
       -
           none_in_thread_have_keyword : string option;

     

       119
       119
       -
           has_keyword : string option;

     

       120
       120
       -
           not_keyword : string option;

     

       121
       121
       -
           has_attachment : bool option;

     

       122
       122
       -
           text : string option;

     

       123
       123
       -
           from : string option;

     

       124
       124
       -
           to_ : string option;

     

       125
       125
       -
           cc : string option;

     

       126
       126
       -
           bcc : string option;

     

       127
       127
       -
           subject : string option;

     

       128
       128
       -
           body : string option;

     

       129
       129
       -
           header : (string * string option) option;

     

       130
       130
       -
         }

     

       131
       131
       -
       

     

       132
       132
       -
         val jsont : t Jsont.t

     

       133
       133
       -
       end

     

       134
       134
       -
       

     

       135
       135
       -
       (** {1 Email/get Arguments} *)

     

       136
       136
       -
       

     

       137
       137
       -
       (** Extra arguments for Email/get beyond standard /get. *)

     

       138
       138
       -
       type get_args_extra = {

     

       139
       139
       -
         body_properties : string list option;

     

       140
       140
       -
         fetch_text_body_values : bool;

     

       141
       141
       -
         fetch_html_body_values : bool;

     

       142
       142
       -
         fetch_all_body_values : bool;

     

       143
       143
       -
         max_body_value_bytes : int64 option;

     

       144
       144
       -
       }

     

       145
       145
       -
       

     

       146
       146
       -
       val get_args_extra_jsont : get_args_extra Jsont.t

-53

proto/mail/email_address.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         name : string option;

     

       8
       8
       -
         email : string;

     

       9
       9
       -
       }

     

       10
       10
       -
       

     

       11
       11
       -
       let create ?name email = { name; email }

     

       12
       12
       -
       

     

       13
       13
       -
       let name t = t.name

     

       14
       14
       -
       let email t = t.email

     

       15
       15
       -
       

     

       16
       16
       -
       let equal a b = a.email = b.email

     

       17
       17
       -
       

     

       18
       18
       -
       let pp ppf t =

     

       19
       19
       -
         match t.name with

     

       20
       20
       -
         | Some name -> Format.fprintf ppf "%s <%s>" name t.email

     

       21
       21
       -
         | None -> Format.pp_print_string ppf t.email

     

       22
       22
       -
       

     

       23
       23
       -
       let make name email = { name; email }

     

       24
       24
       -
       

     

       25
       25
       -
       let jsont =

     

       26
       26
       -
         let kind = "EmailAddress" in

     

       27
       27
       -
         Jsont.Object.map ~kind make

     

       28
       28
       -
         |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name

     

       29
       29
       -
         |> Jsont.Object.mem "email" Jsont.string ~enc:email

     

       30
       30
       -
         |> Jsont.Object.finish

     

       31
       31
       -
       

     

       32
       32
       -
       module Group = struct

     

       33
       33
       -
         type address = t

     

       34
       34
       -
       

     

       35
       35
       -
         type t = {

     

       36
       36
       -
           name : string option;

     

       37
       37
       -
           addresses : address list;

     

       38
       38
       -
         }

     

       39
       39
       -
       

     

       40
       40
       -
         let create ?name addresses = { name; addresses }

     

       41
       41
       -
       

     

       42
       42
       -
         let name t = t.name

     

       43
       43
       -
         let addresses t = t.addresses

     

       44
       44
       -
       

     

       45
       45
       -
         let make name addresses = { name; addresses }

     

       46
       46
       -
       

     

       47
       47
       -
         let jsont =

     

       48
       48
       -
           let kind = "EmailAddressGroup" in

     

       49
       49
       -
           Jsont.Object.map ~kind make

     

       50
       50
       -
           |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name

     

       51
       51
       -
           |> Jsont.Object.mem "addresses" (Jsont.list jsont) ~enc:addresses

     

       52
       52
       -
           |> Jsont.Object.finish

     

       53
       53
       -
       end

-49

proto/mail/email_address.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Email address types as defined in RFC 8621 Section 4.1.2.3 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Email Address} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** An email address with optional display name. *)

     

       11
       11
       -
       type t = {

     

       12
       12
       -
         name : string option;

     

       13
       13
       -
         (** The display name (from the phrase in RFC 5322). *)

     

       14
       14
       -
         email : string;

     

       15
       15
       -
         (** The email address (addr-spec in RFC 5322). *)

     

       16
       16
       -
       }

     

       17
       17
       -
       

     

       18
       18
       -
       val create : ?name:string -> string -> t

     

       19
       19
       -
       (** [create ?name email] creates an email address. *)

     

       20
       20
       -
       

     

       21
       21
       -
       val name : t -> string option

     

       22
       22
       -
       val email : t -> string

     

       23
       23
       -
       

     

       24
       24
       -
       val equal : t -> t -> bool

     

       25
       25
       -
       val pp : Format.formatter -> t -> unit

     

       26
       26
       -
       

     

       27
       27
       -
       val jsont : t Jsont.t

     

       28
       28
       -
       (** JSON codec for email addresses. *)

     

       29
       29
       -
       

     

       30
       30
       -
       (** {1 Address Groups} *)

     

       31
       31
       -
       

     

       32
       32
       -
       (** A group of email addresses with an optional group name. *)

     

       33
       33
       -
       module Group : sig

     

       34
       34
       -
         type address = t

     

       35
       35
       -
       

     

       36
       36
       -
         type t = {

     

       37
       37
       -
           name : string option;

     

       38
       38
       -
           (** The group name, or [None] for ungrouped addresses. *)

     

       39
       39
       -
           addresses : address list;

     

       40
       40
       -
           (** The addresses in this group. *)

     

       41
       41
       -
         }

     

       42
       42
       -
       

     

       43
       43
       -
         val create : ?name:string -> address list -> t

     

       44
       44
       -
       

     

       45
       45
       -
         val name : t -> string option

     

       46
       46
       -
         val addresses : t -> address list

     

       47
       47
       -
       

     

       48
       48
       -
         val jsont : t Jsont.t

     

       49
       49
       -
       end

-85

proto/mail/email_body.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Value = struct

     

       7
       7
       -
         type t = {

     

       8
       8
       -
           value : string;

     

       9
       9
       -
           is_encoding_problem : bool;

     

       10
       10
       -
           is_truncated : bool;

     

       11
       11
       -
         }

     

       12
       12
       -
       

     

       13
       13
       -
         let value t = t.value

     

       14
       14
       -
         let is_encoding_problem t = t.is_encoding_problem

     

       15
       15
       -
         let is_truncated t = t.is_truncated

     

       16
       16
       -
       

     

       17
       17
       -
         let make value is_encoding_problem is_truncated =

     

       18
       18
       -
           { value; is_encoding_problem; is_truncated }

     

       19
       19
       -
       

     

       20
       20
       -
         let jsont =

     

       21
       21
       -
           let kind = "EmailBodyValue" in

     

       22
       22
       -
           Jsont.Object.map ~kind make

     

       23
       23
       -
           |> Jsont.Object.mem "value" Jsont.string ~enc:value

     

       24
       24
       -
           |> Jsont.Object.mem "isEncodingProblem" Jsont.bool ~dec_absent:false

     

       25
       25
       -
                ~enc:is_encoding_problem ~enc_omit:(fun b -> not b)

     

       26
       26
       -
           |> Jsont.Object.mem "isTruncated" Jsont.bool ~dec_absent:false

     

       27
       27
       -
                ~enc:is_truncated ~enc_omit:(fun b -> not b)

     

       28
       28
       -
           |> Jsont.Object.finish

     

       29
       29
       -
       end

     

       30
       30
       -
       

     

       31
       31
       -
       module Part = struct

     

       32
       32
       -
         type t = {

     

       33
       33
       -
           part_id : string option;

     

       34
       34
       -
           blob_id : Jmap_proto.Id.t option;

     

       35
       35
       -
           size : int64 option;

     

       36
       36
       -
           headers : Email_header.t list option;

     

       37
       37
       -
           name : string option;

     

       38
       38
       -
           type_ : string;

     

       39
       39
       -
           charset : string option;

     

       40
       40
       -
           disposition : string option;

     

       41
       41
       -
           cid : string option;

     

       42
       42
       -
           language : string list option;

     

       43
       43
       -
           location : string option;

     

       44
       44
       -
           sub_parts : t list option;

     

       45
       45
       -
         }

     

       46
       46
       -
       

     

       47
       47
       -
         let part_id t = t.part_id

     

       48
       48
       -
         let blob_id t = t.blob_id

     

       49
       49
       -
         let size t = t.size

     

       50
       50
       -
         let headers t = t.headers

     

       51
       51
       -
         let name t = t.name

     

       52
       52
       -
         let type_ t = t.type_

     

       53
       53
       -
         let charset t = t.charset

     

       54
       54
       -
         let disposition t = t.disposition

     

       55
       55
       -
         let cid t = t.cid

     

       56
       56
       -
         let language t = t.language

     

       57
       57
       -
         let location t = t.location

     

       58
       58
       -
         let sub_parts t = t.sub_parts

     

       59
       59
       -
       

     

       60
       60
       -
         let rec jsont =

     

       61
       61
       -
           let kind = "EmailBodyPart" in

     

       62
       62
       -
           let make part_id blob_id size headers name type_ charset disposition

     

       63
       63
       -
               cid language location sub_parts =

     

       64
       64
       -
             { part_id; blob_id; size; headers; name; type_; charset; disposition;

     

       65
       65
       -
               cid; language; location; sub_parts }

     

       66
       66
       -
           in

     

       67
       67
       -
           lazy (

     

       68
       68
       -
             Jsont.Object.map ~kind make

     

       69
       69
       -
             |> Jsont.Object.opt_mem "partId" Jsont.string ~enc:part_id

     

       70
       70
       -
             |> Jsont.Object.opt_mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id

     

       71
       71
       -
             |> Jsont.Object.opt_mem "size" Jmap_proto.Int53.Unsigned.jsont ~enc:size

     

       72
       72
       -
             |> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers

     

       73
       73
       -
             |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name

     

       74
       74
       -
             |> Jsont.Object.mem "type" Jsont.string ~enc:type_

     

       75
       75
       -
             |> Jsont.Object.opt_mem "charset" Jsont.string ~enc:charset

     

       76
       76
       -
             |> Jsont.Object.opt_mem "disposition" Jsont.string ~enc:disposition

     

       77
       77
       -
             |> Jsont.Object.opt_mem "cid" Jsont.string ~enc:cid

     

       78
       78
       -
             |> Jsont.Object.opt_mem "language" (Jsont.list Jsont.string) ~enc:language

     

       79
       79
       -
             |> Jsont.Object.opt_mem "location" Jsont.string ~enc:location

     

       80
       80
       -
             |> Jsont.Object.opt_mem "subParts" (Jsont.list (Jsont.rec' jsont)) ~enc:sub_parts

     

       81
       81
       -
             |> Jsont.Object.finish

     

       82
       82
       -
           )

     

       83
       83
       -
       

     

       84
       84
       -
         let jsont = Lazy.force jsont

     

       85
       85
       -
       end

-73

proto/mail/email_body.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Email body types as defined in RFC 8621 Section 4.1.4 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Body Value} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Fetched body part content. *)

     

       11
       11
       -
       module Value : sig

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           value : string;

     

       14
       14
       -
           (** The body part content. *)

     

       15
       15
       -
           is_encoding_problem : bool;

     

       16
       16
       -
           (** True if there was a problem decoding the content transfer encoding. *)

     

       17
       17
       -
           is_truncated : bool;

     

       18
       18
       -
           (** True if the value was truncated. *)

     

       19
       19
       -
         }

     

       20
       20
       -
       

     

       21
       21
       -
         val value : t -> string

     

       22
       22
       -
         val is_encoding_problem : t -> bool

     

       23
       23
       -
         val is_truncated : t -> bool

     

       24
       24
       -
       

     

       25
       25
       -
         val jsont : t Jsont.t

     

       26
       26
       -
       end

     

       27
       27
       -
       

     

       28
       28
       -
       (** {1 Body Part} *)

     

       29
       29
       -
       

     

       30
       30
       -
       (** An email body part structure. *)

     

       31
       31
       -
       module Part : sig

     

       32
       32
       -
         type t = {

     

       33
       33
       -
           part_id : string option;

     

       34
       34
       -
           (** Identifier for this part, used to fetch content. *)

     

       35
       35
       -
           blob_id : Jmap_proto.Id.t option;

     

       36
       36
       -
           (** Blob id if the part can be fetched as a blob. *)

     

       37
       37
       -
           size : int64 option;

     

       38
       38
       -
           (** Size in octets. *)

     

       39
       39
       -
           headers : Email_header.t list option;

     

       40
       40
       -
           (** Headers specific to this part. *)

     

       41
       41
       -
           name : string option;

     

       42
       42
       -
           (** Suggested filename from Content-Disposition. *)

     

       43
       43
       -
           type_ : string;

     

       44
       44
       -
           (** MIME type (e.g., "text/plain"). *)

     

       45
       45
       -
           charset : string option;

     

       46
       46
       -
           (** Character set parameter. *)

     

       47
       47
       -
           disposition : string option;

     

       48
       48
       -
           (** Content-Disposition value. *)

     

       49
       49
       -
           cid : string option;

     

       50
       50
       -
           (** Content-ID value. *)

     

       51
       51
       -
           language : string list option;

     

       52
       52
       -
           (** Content-Language values. *)

     

       53
       53
       -
           location : string option;

     

       54
       54
       -
           (** Content-Location value. *)

     

       55
       55
       -
           sub_parts : t list option;

     

       56
       56
       -
           (** Nested parts for multipart types. *)

     

       57
       57
       -
         }

     

       58
       58
       -
       

     

       59
       59
       -
         val part_id : t -> string option

     

       60
       60
       -
         val blob_id : t -> Jmap_proto.Id.t option

     

       61
       61
       -
         val size : t -> int64 option

     

       62
       62
       -
         val headers : t -> Email_header.t list option

     

       63
       63
       -
         val name : t -> string option

     

       64
       64
       -
         val type_ : t -> string

     

       65
       65
       -
         val charset : t -> string option

     

       66
       66
       -
         val disposition : t -> string option

     

       67
       67
       -
         val cid : t -> string option

     

       68
       68
       -
         val language : t -> string list option

     

       69
       69
       -
         val location : t -> string option

     

       70
       70
       -
         val sub_parts : t -> t list option

     

       71
       71
       -
       

     

       72
       72
       -
         val jsont : t Jsont.t

     

       73
       73
       -
       end

-39

proto/mail/email_header.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         name : string;

     

       8
       8
       -
         value : string;

     

       9
       9
       -
       }

     

       10
       10
       -
       

     

       11
       11
       -
       let create ~name ~value = { name; value }

     

       12
       12
       -
       

     

       13
       13
       -
       let name t = t.name

     

       14
       14
       -
       let value t = t.value

     

       15
       15
       -
       

     

       16
       16
       -
       let make name value = { name; value }

     

       17
       17
       -
       

     

       18
       18
       -
       let jsont =

     

       19
       19
       -
         let kind = "EmailHeader" in

     

       20
       20
       -
         Jsont.Object.map ~kind make

     

       21
       21
       -
         |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       22
       22
       -
         |> Jsont.Object.mem "value" Jsont.string ~enc:value

     

       23
       23
       -
         |> Jsont.Object.finish

     

       24
       24
       -
       

     

       25
       25
       -
       (* Header parsed forms - these are used with header:Name:form properties *)

     

       26
       26
       -
       

     

       27
       27
       -
       let raw_jsont = Jsont.string

     

       28
       28
       -
       

     

       29
       29
       -
       let text_jsont = Jsont.string

     

       30
       30
       -
       

     

       31
       31
       -
       let addresses_jsont = Jsont.list Email_address.jsont

     

       32
       32
       -
       

     

       33
       33
       -
       let grouped_addresses_jsont = Jsont.list Email_address.Group.jsont

     

       34
       34
       -
       

     

       35
       35
       -
       let message_ids_jsont = Jsont.list Jsont.string

     

       36
       36
       -
       

     

       37
       37
       -
       let date_jsont = Jmap_proto.Date.Rfc3339.jsont

     

       38
       38
       -
       

     

       39
       39
       -
       let urls_jsont = Jsont.list Jsont.string

-49

proto/mail/email_header.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Email header types as defined in RFC 8621 Section 4.1.2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Raw Headers} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** A raw email header name-value pair. *)

     

       11
       11
       -
       type t = {

     

       12
       12
       -
         name : string;

     

       13
       13
       -
         (** The header field name. *)

     

       14
       14
       -
         value : string;

     

       15
       15
       -
         (** The raw header field value. *)

     

       16
       16
       -
       }

     

       17
       17
       -
       

     

       18
       18
       -
       val create : name:string -> value:string -> t

     

       19
       19
       -
       

     

       20
       20
       -
       val name : t -> string

     

       21
       21
       -
       val value : t -> string

     

       22
       22
       -
       

     

       23
       23
       -
       val jsont : t Jsont.t

     

       24
       24
       -
       

     

       25
       25
       -
       (** {1 Header Parsed Forms}

     

       26
       26
       -
       

     

       27
       27
       -
           RFC 8621 defines several parsed forms for headers.

     

       28
       28
       -
           These can be requested via the header:Name:form properties. *)

     

       29
       29
       -
       

     

       30
       30
       -
       (** The raw form - header value as-is. *)

     

       31
       31
       -
       val raw_jsont : string Jsont.t

     

       32
       32
       -
       

     

       33
       33
       -
       (** The text form - decoded and unfolded value. *)

     

       34
       34
       -
       val text_jsont : string Jsont.t

     

       35
       35
       -
       

     

       36
       36
       -
       (** The addresses form - list of email addresses. *)

     

       37
       37
       -
       val addresses_jsont : Email_address.t list Jsont.t

     

       38
       38
       -
       

     

       39
       39
       -
       (** The grouped addresses form - addresses with group info. *)

     

       40
       40
       -
       val grouped_addresses_jsont : Email_address.Group.t list Jsont.t

     

       41
       41
       -
       

     

       42
       42
       -
       (** The message IDs form - list of message-id strings. *)

     

       43
       43
       -
       val message_ids_jsont : string list Jsont.t

     

       44
       44
       -
       

     

       45
       45
       -
       (** The date form - parsed RFC 3339 date. *)

     

       46
       46
       -
       val date_jsont : Ptime.t Jsont.t

     

       47
       47
       -
       

     

       48
       48
       -
       (** The URLs form - list of URL strings. *)

     

       49
       49
       -
       val urls_jsont : string list Jsont.t

-40

proto/mail/identity.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         id : Jmap_proto.Id.t;

     

       8
       8
       -
         name : string;

     

       9
       9
       -
         email : string;

     

       10
       10
       -
         reply_to : Email_address.t list option;

     

       11
       11
       -
         bcc : Email_address.t list option;

     

       12
       12
       -
         text_signature : string;

     

       13
       13
       -
         html_signature : string;

     

       14
       14
       -
         may_delete : bool;

     

       15
       15
       -
       }

     

       16
       16
       -
       

     

       17
       17
       -
       let id t = t.id

     

       18
       18
       -
       let name t = t.name

     

       19
       19
       -
       let email t = t.email

     

       20
       20
       -
       let reply_to t = t.reply_to

     

       21
       21
       -
       let bcc t = t.bcc

     

       22
       22
       -
       let text_signature t = t.text_signature

     

       23
       23
       -
       let html_signature t = t.html_signature

     

       24
       24
       -
       let may_delete t = t.may_delete

     

       25
       25
       -
       

     

       26
       26
       -
       let make id name email reply_to bcc text_signature html_signature may_delete =

     

       27
       27
       -
         { id; name; email; reply_to; bcc; text_signature; html_signature; may_delete }

     

       28
       28
       -
       

     

       29
       29
       -
       let jsont =

     

       30
       30
       -
         let kind = "Identity" in

     

       31
       31
       -
         Jsont.Object.map ~kind make

     

       32
       32
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       33
       33
       -
         |> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:name

     

       34
       34
       -
         |> Jsont.Object.mem "email" Jsont.string ~enc:email

     

       35
       35
       -
         |> Jsont.Object.opt_mem "replyTo" (Jsont.list Email_address.jsont) ~enc:reply_to

     

       36
       36
       -
         |> Jsont.Object.opt_mem "bcc" (Jsont.list Email_address.jsont) ~enc:bcc

     

       37
       37
       -
         |> Jsont.Object.mem "textSignature" Jsont.string ~dec_absent:"" ~enc:text_signature

     

       38
       38
       -
         |> Jsont.Object.mem "htmlSignature" Jsont.string ~dec_absent:"" ~enc:html_signature

     

       39
       39
       -
         |> Jsont.Object.mem "mayDelete" Jsont.bool ~enc:may_delete

     

       40
       40
       -
         |> Jsont.Object.finish

-36

proto/mail/identity.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Identity type as defined in RFC 8621 Section 6 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         id : Jmap_proto.Id.t;

     

       10
       10
       -
         (** Server-assigned identity id. *)

     

       11
       11
       -
         name : string;

     

       12
       12
       -
         (** Display name for sent emails. *)

     

       13
       13
       -
         email : string;

     

       14
       14
       -
         (** The email address to use. *)

     

       15
       15
       -
         reply_to : Email_address.t list option;

     

       16
       16
       -
         (** Default Reply-To addresses. *)

     

       17
       17
       -
         bcc : Email_address.t list option;

     

       18
       18
       -
         (** Default BCC addresses. *)

     

       19
       19
       -
         text_signature : string;

     

       20
       20
       -
         (** Plain text signature. *)

     

       21
       21
       -
         html_signature : string;

     

       22
       22
       -
         (** HTML signature. *)

     

       23
       23
       -
         may_delete : bool;

     

       24
       24
       -
         (** Whether the user may delete this identity. *)

     

       25
       25
       -
       }

     

       26
       26
       -
       

     

       27
       27
       -
       val id : t -> Jmap_proto.Id.t

     

       28
       28
       -
       val name : t -> string

     

       29
       29
       -
       val email : t -> string

     

       30
       30
       -
       val reply_to : t -> Email_address.t list option

     

       31
       31
       -
       val bcc : t -> Email_address.t list option

     

       32
       32
       -
       val text_signature : t -> string

     

       33
       33
       -
       val html_signature : t -> string

     

       34
       34
       -
       val may_delete : t -> bool

     

       35
       35
       -
       

     

       36
       36
       -
       val jsont : t Jsont.t

-20

proto/mail/jmap_mail.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP Mail Types (RFC 8621)

     

       7
       7
       -
       

     

       8
       8
       -
           This module re-exports all JMAP mail protocol types. *)

     

       9
       9
       -
       

     

       10
       10
       -
       module Email_address = Email_address

     

       11
       11
       -
       module Email_header = Email_header

     

       12
       12
       -
       module Email_body = Email_body

     

       13
       13
       -
       module Mailbox = Mailbox

     

       14
       14
       -
       module Thread = Thread

     

       15
       15
       -
       module Email = Email

     

       16
       16
       -
       module Search_snippet = Search_snippet

     

       17
       17
       -
       module Identity = Identity

     

       18
       18
       -
       module Submission = Submission

     

       19
       19
       -
       module Vacation = Vacation

     

       20
       20
       -
       module Mail_filter = Mail_filter

-16

proto/mail/mail_filter.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type email_filter = Email.Filter_condition.t Jmap_proto.Filter.filter

     

       7
       7
       -
       

     

       8
       8
       -
       let email_filter_jsont = Jmap_proto.Filter.filter_jsont Email.Filter_condition.jsont

     

       9
       9
       -
       

     

       10
       10
       -
       type mailbox_filter = Mailbox.Filter_condition.t Jmap_proto.Filter.filter

     

       11
       11
       -
       

     

       12
       12
       -
       let mailbox_filter_jsont = Jmap_proto.Filter.filter_jsont Mailbox.Filter_condition.jsont

     

       13
       13
       -
       

     

       14
       14
       -
       type submission_filter = Submission.Filter_condition.t Jmap_proto.Filter.filter

     

       15
       15
       -
       

     

       16
       16
       -
       let submission_filter_jsont = Jmap_proto.Filter.filter_jsont Submission.Filter_condition.jsont

-21

proto/mail/mail_filter.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Mail-specific filter types *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** Email filter with Email-specific conditions. *)

     

       9
       9
       -
       type email_filter = Email.Filter_condition.t Jmap_proto.Filter.filter

     

       10
       10
       -
       

     

       11
       11
       -
       val email_filter_jsont : email_filter Jsont.t

     

       12
       12
       -
       

     

       13
       13
       -
       (** Mailbox filter with Mailbox-specific conditions. *)

     

       14
       14
       -
       type mailbox_filter = Mailbox.Filter_condition.t Jmap_proto.Filter.filter

     

       15
       15
       -
       

     

       16
       16
       -
       val mailbox_filter_jsont : mailbox_filter Jsont.t

     

       17
       17
       -
       

     

       18
       18
       -
       (** EmailSubmission filter with Submission-specific conditions. *)

     

       19
       19
       -
       type submission_filter = Submission.Filter_condition.t Jmap_proto.Filter.filter

     

       20
       20
       -
       

     

       21
       21
       -
       val submission_filter_jsont : submission_filter Jsont.t

-165

proto/mail/mailbox.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Rights = struct

     

       7
       7
       -
         type t = {

     

       8
       8
       -
           may_read_items : bool;

     

       9
       9
       -
           may_add_items : bool;

     

       10
       10
       -
           may_remove_items : bool;

     

       11
       11
       -
           may_set_seen : bool;

     

       12
       12
       -
           may_set_keywords : bool;

     

       13
       13
       -
           may_create_child : bool;

     

       14
       14
       -
           may_rename : bool;

     

       15
       15
       -
           may_delete : bool;

     

       16
       16
       -
           may_submit : bool;

     

       17
       17
       -
         }

     

       18
       18
       -
       

     

       19
       19
       -
         let may_read_items t = t.may_read_items

     

       20
       20
       -
         let may_add_items t = t.may_add_items

     

       21
       21
       -
         let may_remove_items t = t.may_remove_items

     

       22
       22
       -
         let may_set_seen t = t.may_set_seen

     

       23
       23
       -
         let may_set_keywords t = t.may_set_keywords

     

       24
       24
       -
         let may_create_child t = t.may_create_child

     

       25
       25
       -
         let may_rename t = t.may_rename

     

       26
       26
       -
         let may_delete t = t.may_delete

     

       27
       27
       -
         let may_submit t = t.may_submit

     

       28
       28
       -
       

     

       29
       29
       -
         let make may_read_items may_add_items may_remove_items may_set_seen

     

       30
       30
       -
             may_set_keywords may_create_child may_rename may_delete may_submit =

     

       31
       31
       -
           { may_read_items; may_add_items; may_remove_items; may_set_seen;

     

       32
       32
       -
             may_set_keywords; may_create_child; may_rename; may_delete; may_submit }

     

       33
       33
       -
       

     

       34
       34
       -
         let jsont =

     

       35
       35
       -
           let kind = "MailboxRights" in

     

       36
       36
       -
           Jsont.Object.map ~kind make

     

       37
       37
       -
           |> Jsont.Object.mem "mayReadItems" Jsont.bool ~enc:may_read_items

     

       38
       38
       -
           |> Jsont.Object.mem "mayAddItems" Jsont.bool ~enc:may_add_items

     

       39
       39
       -
           |> Jsont.Object.mem "mayRemoveItems" Jsont.bool ~enc:may_remove_items

     

       40
       40
       -
           |> Jsont.Object.mem "maySetSeen" Jsont.bool ~enc:may_set_seen

     

       41
       41
       -
           |> Jsont.Object.mem "maySetKeywords" Jsont.bool ~enc:may_set_keywords

     

       42
       42
       -
           |> Jsont.Object.mem "mayCreateChild" Jsont.bool ~enc:may_create_child

     

       43
       43
       -
           |> Jsont.Object.mem "mayRename" Jsont.bool ~enc:may_rename

     

       44
       44
       -
           |> Jsont.Object.mem "mayDelete" Jsont.bool ~enc:may_delete

     

       45
       45
       -
           |> Jsont.Object.mem "maySubmit" Jsont.bool ~enc:may_submit

     

       46
       46
       -
           |> Jsont.Object.finish

     

       47
       47
       -
       end

     

       48
       48
       -
       

     

       49
       49
       -
       type role =

     

       50
       50
       -
         | All

     

       51
       51
       -
         | Archive

     

       52
       52
       -
         | Drafts

     

       53
       53
       -
         | Flagged

     

       54
       54
       -
         | Important

     

       55
       55
       -
         | Inbox

     

       56
       56
       -
         | Junk

     

       57
       57
       -
         | Sent

     

       58
       58
       -
         | Subscribed

     

       59
       59
       -
         | Trash

     

       60
       60
       -
         | Other of string

     

       61
       61
       -
       

     

       62
       62
       -
       let role_to_string = function

     

       63
       63
       -
         | All -> "all"

     

       64
       64
       -
         | Archive -> "archive"

     

       65
       65
       -
         | Drafts -> "drafts"

     

       66
       66
       -
         | Flagged -> "flagged"

     

       67
       67
       -
         | Important -> "important"

     

       68
       68
       -
         | Inbox -> "inbox"

     

       69
       69
       -
         | Junk -> "junk"

     

       70
       70
       -
         | Sent -> "sent"

     

       71
       71
       -
         | Subscribed -> "subscribed"

     

       72
       72
       -
         | Trash -> "trash"

     

       73
       73
       -
         | Other s -> s

     

       74
       74
       -
       

     

       75
       75
       -
       let role_of_string = function

     

       76
       76
       -
         | "all" -> All

     

       77
       77
       -
         | "archive" -> Archive

     

       78
       78
       -
         | "drafts" -> Drafts

     

       79
       79
       -
         | "flagged" -> Flagged

     

       80
       80
       -
         | "important" -> Important

     

       81
       81
       -
         | "inbox" -> Inbox

     

       82
       82
       -
         | "junk" -> Junk

     

       83
       83
       -
         | "sent" -> Sent

     

       84
       84
       -
         | "subscribed" -> Subscribed

     

       85
       85
       -
         | "trash" -> Trash

     

       86
       86
       -
         | s -> Other s

     

       87
       87
       -
       

     

       88
       88
       -
       let role_jsont =

     

       89
       89
       -
         Jsont.map ~kind:"MailboxRole"

     

       90
       90
       -
           ~dec:(fun s -> role_of_string s)

     

       91
       91
       -
           ~enc:role_to_string

     

       92
       92
       -
           Jsont.string

     

       93
       93
       -
       

     

       94
       94
       -
       type t = {

     

       95
       95
       -
         id : Jmap_proto.Id.t;

     

       96
       96
       -
         name : string;

     

       97
       97
       -
         parent_id : Jmap_proto.Id.t option;

     

       98
       98
       -
         role : role option;

     

       99
       99
       -
         sort_order : int64;

     

       100
       100
       -
         total_emails : int64;

     

       101
       101
       -
         unread_emails : int64;

     

       102
       102
       -
         total_threads : int64;

     

       103
       103
       -
         unread_threads : int64;

     

       104
       104
       -
         my_rights : Rights.t;

     

       105
       105
       -
         is_subscribed : bool;

     

       106
       106
       -
       }

     

       107
       107
       -
       

     

       108
       108
       -
       let id t = t.id

     

       109
       109
       -
       let name t = t.name

     

       110
       110
       -
       let parent_id t = t.parent_id

     

       111
       111
       -
       let role t = t.role

     

       112
       112
       -
       let sort_order t = t.sort_order

     

       113
       113
       -
       let total_emails t = t.total_emails

     

       114
       114
       -
       let unread_emails t = t.unread_emails

     

       115
       115
       -
       let total_threads t = t.total_threads

     

       116
       116
       -
       let unread_threads t = t.unread_threads

     

       117
       117
       -
       let my_rights t = t.my_rights

     

       118
       118
       -
       let is_subscribed t = t.is_subscribed

     

       119
       119
       -
       

     

       120
       120
       -
       let make id name parent_id role sort_order total_emails unread_emails

     

       121
       121
       -
           total_threads unread_threads my_rights is_subscribed =

     

       122
       122
       -
         { id; name; parent_id; role; sort_order; total_emails; unread_emails;

     

       123
       123
       -
           total_threads; unread_threads; my_rights; is_subscribed }

     

       124
       124
       -
       

     

       125
       125
       -
       let jsont =

     

       126
       126
       -
         let kind = "Mailbox" in

     

       127
       127
       -
         Jsont.Object.map ~kind make

     

       128
       128
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       129
       129
       -
         |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       130
       130
       -
         |> Jsont.Object.opt_mem "parentId" Jmap_proto.Id.jsont ~enc:parent_id

     

       131
       131
       -
         |> Jsont.Object.opt_mem "role" role_jsont ~enc:role

     

       132
       132
       -
         |> Jsont.Object.mem "sortOrder" Jmap_proto.Int53.Unsigned.jsont ~dec_absent:0L ~enc:sort_order

     

       133
       133
       -
         |> Jsont.Object.mem "totalEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:total_emails

     

       134
       134
       -
         |> Jsont.Object.mem "unreadEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:unread_emails

     

       135
       135
       -
         |> Jsont.Object.mem "totalThreads" Jmap_proto.Int53.Unsigned.jsont ~enc:total_threads

     

       136
       136
       -
         |> Jsont.Object.mem "unreadThreads" Jmap_proto.Int53.Unsigned.jsont ~enc:unread_threads

     

       137
       137
       -
         |> Jsont.Object.mem "myRights" Rights.jsont ~enc:my_rights

     

       138
       138
       -
         |> Jsont.Object.mem "isSubscribed" Jsont.bool ~enc:is_subscribed

     

       139
       139
       -
         |> Jsont.Object.finish

     

       140
       140
       -
       

     

       141
       141
       -
       module Filter_condition = struct

     

       142
       142
       -
         type t = {

     

       143
       143
       -
           parent_id : Jmap_proto.Id.t option option;

     

       144
       144
       -
           name : string option;

     

       145
       145
       -
           role : role option option;

     

       146
       146
       -
           has_any_role : bool option;

     

       147
       147
       -
           is_subscribed : bool option;

     

       148
       148
       -
         }

     

       149
       149
       -
       

     

       150
       150
       -
         let make parent_id name role has_any_role is_subscribed =

     

       151
       151
       -
           { parent_id; name; role; has_any_role; is_subscribed }

     

       152
       152
       -
       

     

       153
       153
       -
         let jsont =

     

       154
       154
       -
           let kind = "MailboxFilterCondition" in

     

       155
       155
       -
           (* parentId can be null (meaning top-level) or an id *)

     

       156
       156
       -
           let nullable_id = Jsont.(some Jmap_proto.Id.jsont) in

     

       157
       157
       -
           let nullable_role = Jsont.(some role_jsont) in

     

       158
       158
       -
           Jsont.Object.map ~kind make

     

       159
       159
       -
           |> Jsont.Object.opt_mem "parentId" nullable_id ~enc:(fun f -> f.parent_id)

     

       160
       160
       -
           |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun f -> f.name)

     

       161
       161
       -
           |> Jsont.Object.opt_mem "role" nullable_role ~enc:(fun f -> f.role)

     

       162
       162
       -
           |> Jsont.Object.opt_mem "hasAnyRole" Jsont.bool ~enc:(fun f -> f.has_any_role)

     

       163
       163
       -
           |> Jsont.Object.opt_mem "isSubscribed" Jsont.bool ~enc:(fun f -> f.is_subscribed)

     

       164
       164
       -
           |> Jsont.Object.finish

     

       165
       165
       -
       end

-116

proto/mail/mailbox.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Mailbox type as defined in RFC 8621 Section 2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Mailbox Rights} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Rights the user has on a mailbox. *)

     

       11
       11
       -
       module Rights : sig

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           may_read_items : bool;

     

       14
       14
       -
           may_add_items : bool;

     

       15
       15
       -
           may_remove_items : bool;

     

       16
       16
       -
           may_set_seen : bool;

     

       17
       17
       -
           may_set_keywords : bool;

     

       18
       18
       -
           may_create_child : bool;

     

       19
       19
       -
           may_rename : bool;

     

       20
       20
       -
           may_delete : bool;

     

       21
       21
       -
           may_submit : bool;

     

       22
       22
       -
         }

     

       23
       23
       -
       

     

       24
       24
       -
         val may_read_items : t -> bool

     

       25
       25
       -
         val may_add_items : t -> bool

     

       26
       26
       -
         val may_remove_items : t -> bool

     

       27
       27
       -
         val may_set_seen : t -> bool

     

       28
       28
       -
         val may_set_keywords : t -> bool

     

       29
       29
       -
         val may_create_child : t -> bool

     

       30
       30
       -
         val may_rename : t -> bool

     

       31
       31
       -
         val may_delete : t -> bool

     

       32
       32
       -
         val may_submit : t -> bool

     

       33
       33
       -
       

     

       34
       34
       -
         val jsont : t Jsont.t

     

       35
       35
       -
       end

     

       36
       36
       -
       

     

       37
       37
       -
       (** {1 Standard Roles} *)

     

       38
       38
       -
       

     

       39
       39
       -
       (** Standard mailbox roles per RFC 8621 Section 2. *)

     

       40
       40
       -
       type role =

     

       41
       41
       -
         | All

     

       42
       42
       -
         | Archive

     

       43
       43
       -
         | Drafts

     

       44
       44
       -
         | Flagged

     

       45
       45
       -
         | Important

     

       46
       46
       -
         | Inbox

     

       47
       47
       -
         | Junk

     

       48
       48
       -
         | Sent

     

       49
       49
       -
         | Subscribed

     

       50
       50
       -
         | Trash

     

       51
       51
       -
         | Other of string

     

       52
       52
       -
       

     

       53
       53
       -
       val role_to_string : role -> string

     

       54
       54
       -
       val role_of_string : string -> role

     

       55
       55
       -
       val role_jsont : role Jsont.t

     

       56
       56
       -
       

     

       57
       57
       -
       (** {1 Mailbox} *)

     

       58
       58
       -
       

     

       59
       59
       -
       type t = {

     

       60
       60
       -
         id : Jmap_proto.Id.t;

     

       61
       61
       -
         (** Server-assigned mailbox id. *)

     

       62
       62
       -
         name : string;

     

       63
       63
       -
         (** User-visible name (UTF-8). *)

     

       64
       64
       -
         parent_id : Jmap_proto.Id.t option;

     

       65
       65
       -
         (** Id of parent mailbox, or [None] for root. *)

     

       66
       66
       -
         role : role option;

     

       67
       67
       -
         (** Standard role, if any. *)

     

       68
       68
       -
         sort_order : int64;

     

       69
       69
       -
         (** Sort order hint (lower = displayed first). *)

     

       70
       70
       -
         total_emails : int64;

     

       71
       71
       -
         (** Total number of emails in mailbox. *)

     

       72
       72
       -
         unread_emails : int64;

     

       73
       73
       -
         (** Number of unread emails. *)

     

       74
       74
       -
         total_threads : int64;

     

       75
       75
       -
         (** Total number of threads. *)

     

       76
       76
       -
         unread_threads : int64;

     

       77
       77
       -
         (** Number of threads with unread emails. *)

     

       78
       78
       -
         my_rights : Rights.t;

     

       79
       79
       -
         (** User's rights on this mailbox. *)

     

       80
       80
       -
         is_subscribed : bool;

     

       81
       81
       -
         (** Whether user is subscribed to this mailbox. *)

     

       82
       82
       -
       }

     

       83
       83
       -
       

     

       84
       84
       -
       val id : t -> Jmap_proto.Id.t

     

       85
       85
       -
       val name : t -> string

     

       86
       86
       -
       val parent_id : t -> Jmap_proto.Id.t option

     

       87
       87
       -
       val role : t -> role option

     

       88
       88
       -
       val sort_order : t -> int64

     

       89
       89
       -
       val total_emails : t -> int64

     

       90
       90
       -
       val unread_emails : t -> int64

     

       91
       91
       -
       val total_threads : t -> int64

     

       92
       92
       -
       val unread_threads : t -> int64

     

       93
       93
       -
       val my_rights : t -> Rights.t

     

       94
       94
       -
       val is_subscribed : t -> bool

     

       95
       95
       -
       

     

       96
       96
       -
       val jsont : t Jsont.t

     

       97
       97
       -
       

     

       98
       98
       -
       (** {1 Mailbox Filter Conditions} *)

     

       99
       99
       -
       

     

       100
       100
       -
       (** Filter conditions for Mailbox/query. *)

     

       101
       101
       -
       module Filter_condition : sig

     

       102
       102
       -
         type t = {

     

       103
       103
       -
           parent_id : Jmap_proto.Id.t option option;

     

       104
       104
       -
           (** Filter by parent. [Some None] = top-level only. *)

     

       105
       105
       -
           name : string option;

     

       106
       106
       -
           (** Filter by exact name match. *)

     

       107
       107
       -
           role : role option option;

     

       108
       108
       -
           (** Filter by role. [Some None] = no role. *)

     

       109
       109
       -
           has_any_role : bool option;

     

       110
       110
       -
           (** Filter by whether mailbox has any role. *)

     

       111
       111
       -
           is_subscribed : bool option;

     

       112
       112
       -
           (** Filter by subscription status. *)

     

       113
       113
       -
         }

     

       114
       114
       -
       

     

       115
       115
       -
         val jsont : t Jsont.t

     

       116
       116
       -
       end

-24

proto/mail/search_snippet.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         email_id : Jmap_proto.Id.t;

     

       8
       8
       -
         subject : string option;

     

       9
       9
       -
         preview : string option;

     

       10
       10
       -
       }

     

       11
       11
       -
       

     

       12
       12
       -
       let email_id t = t.email_id

     

       13
       13
       -
       let subject t = t.subject

     

       14
       14
       -
       let preview t = t.preview

     

       15
       15
       -
       

     

       16
       16
       -
       let make email_id subject preview = { email_id; subject; preview }

     

       17
       17
       -
       

     

       18
       18
       -
       let jsont =

     

       19
       19
       -
         let kind = "SearchSnippet" in

     

       20
       20
       -
         Jsont.Object.map ~kind make

     

       21
       21
       -
         |> Jsont.Object.mem "emailId" Jmap_proto.Id.jsont ~enc:email_id

     

       22
       22
       -
         |> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject

     

       23
       23
       -
         |> Jsont.Object.opt_mem "preview" Jsont.string ~enc:preview

     

       24
       24
       -
         |> Jsont.Object.finish

-21

proto/mail/search_snippet.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** SearchSnippet type as defined in RFC 8621 Section 5 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         email_id : Jmap_proto.Id.t;

     

       10
       10
       -
         (** The email this snippet is for. *)

     

       11
       11
       -
         subject : string option;

     

       12
       12
       -
         (** HTML snippet of matching subject text. *)

     

       13
       13
       -
         preview : string option;

     

       14
       14
       -
         (** HTML snippet of matching body text. *)

     

       15
       15
       -
       }

     

       16
       16
       -
       

     

       17
       17
       -
       val email_id : t -> Jmap_proto.Id.t

     

       18
       18
       -
       val subject : t -> string option

     

       19
       19
       -
       val preview : t -> string option

     

       20
       20
       -
       

     

       21
       21
       -
       val jsont : t Jsont.t

-183

proto/mail/submission.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Address = struct

     

       7
       7
       -
         type t = {

     

       8
       8
       -
           email : string;

     

       9
       9
       -
           parameters : (string * string) list option;

     

       10
       10
       -
         }

     

       11
       11
       -
       

     

       12
       12
       -
         let email t = t.email

     

       13
       13
       -
         let parameters t = t.parameters

     

       14
       14
       -
       

     

       15
       15
       -
         let make email parameters = { email; parameters }

     

       16
       16
       -
       

     

       17
       17
       -
         let jsont =

     

       18
       18
       -
           let kind = "EmailSubmission Address" in

     

       19
       19
       -
           Jsont.Object.map ~kind make

     

       20
       20
       -
           |> Jsont.Object.mem "email" Jsont.string ~enc:email

     

       21
       21
       -
           |> Jsont.Object.opt_mem "parameters" (Jmap_proto.Json_map.of_string Jsont.string) ~enc:parameters

     

       22
       22
       -
           |> Jsont.Object.finish

     

       23
       23
       -
       end

     

       24
       24
       -
       

     

       25
       25
       -
       module Envelope = struct

     

       26
       26
       -
         type t = {

     

       27
       27
       -
           mail_from : Address.t;

     

       28
       28
       -
           rcpt_to : Address.t list;

     

       29
       29
       -
         }

     

       30
       30
       -
       

     

       31
       31
       -
         let mail_from t = t.mail_from

     

       32
       32
       -
         let rcpt_to t = t.rcpt_to

     

       33
       33
       -
       

     

       34
       34
       -
         let make mail_from rcpt_to = { mail_from; rcpt_to }

     

       35
       35
       -
       

     

       36
       36
       -
         let jsont =

     

       37
       37
       -
           let kind = "Envelope" in

     

       38
       38
       -
           Jsont.Object.map ~kind make

     

       39
       39
       -
           |> Jsont.Object.mem "mailFrom" Address.jsont ~enc:mail_from

     

       40
       40
       -
           |> Jsont.Object.mem "rcptTo" (Jsont.list Address.jsont) ~enc:rcpt_to

     

       41
       41
       -
           |> Jsont.Object.finish

     

       42
       42
       -
       end

     

       43
       43
       -
       

     

       44
       44
       -
       module Delivery_status = struct

     

       45
       45
       -
         type delivered = Queued | Yes | No | Unknown

     

       46
       46
       -
       

     

       47
       47
       -
         let delivered_to_string = function

     

       48
       48
       -
           | Queued -> "queued"

     

       49
       49
       -
           | Yes -> "yes"

     

       50
       50
       -
           | No -> "no"

     

       51
       51
       -
           | Unknown -> "unknown"

     

       52
       52
       -
       

     

       53
       53
       -
         let delivered_of_string = function

     

       54
       54
       -
           | "queued" -> Queued

     

       55
       55
       -
           | "yes" -> Yes

     

       56
       56
       -
           | "no" -> No

     

       57
       57
       -
           | _ -> Unknown

     

       58
       58
       -
       

     

       59
       59
       -
         let delivered_jsont =

     

       60
       60
       -
           Jsont.map ~kind:"DeliveryStatus.delivered"

     

       61
       61
       -
             ~dec:delivered_of_string ~enc:delivered_to_string Jsont.string

     

       62
       62
       -
       

     

       63
       63
       -
         type displayed = Unknown | Yes

     

       64
       64
       -
       

     

       65
       65
       -
         let displayed_to_string = function

     

       66
       66
       -
           | Unknown -> "unknown"

     

       67
       67
       -
           | Yes -> "yes"

     

       68
       68
       -
       

     

       69
       69
       -
         let displayed_of_string = function

     

       70
       70
       -
           | "yes" -> Yes

     

       71
       71
       -
           | _ -> Unknown

     

       72
       72
       -
       

     

       73
       73
       -
         let displayed_jsont =

     

       74
       74
       -
           Jsont.map ~kind:"DeliveryStatus.displayed"

     

       75
       75
       -
             ~dec:displayed_of_string ~enc:displayed_to_string Jsont.string

     

       76
       76
       -
       

     

       77
       77
       -
         type t = {

     

       78
       78
       -
           smtp_reply : string;

     

       79
       79
       -
           delivered : delivered;

     

       80
       80
       -
           displayed : displayed;

     

       81
       81
       -
         }

     

       82
       82
       -
       

     

       83
       83
       -
         let smtp_reply t = t.smtp_reply

     

       84
       84
       -
         let delivered t = t.delivered

     

       85
       85
       -
         let displayed t = t.displayed

     

       86
       86
       -
       

     

       87
       87
       -
         let make smtp_reply delivered displayed =

     

       88
       88
       -
           { smtp_reply; delivered; displayed }

     

       89
       89
       -
       

     

       90
       90
       -
         let jsont =

     

       91
       91
       -
           let kind = "DeliveryStatus" in

     

       92
       92
       -
           Jsont.Object.map ~kind make

     

       93
       93
       -
           |> Jsont.Object.mem "smtpReply" Jsont.string ~enc:smtp_reply

     

       94
       94
       -
           |> Jsont.Object.mem "delivered" delivered_jsont ~enc:delivered

     

       95
       95
       -
           |> Jsont.Object.mem "displayed" displayed_jsont ~enc:displayed

     

       96
       96
       -
           |> Jsont.Object.finish

     

       97
       97
       -
       end

     

       98
       98
       -
       

     

       99
       99
       -
       type undo_status = Pending | Final | Canceled

     

       100
       100
       -
       

     

       101
       101
       -
       let undo_status_to_string = function

     

       102
       102
       -
         | Pending -> "pending"

     

       103
       103
       -
         | Final -> "final"

     

       104
       104
       -
         | Canceled -> "canceled"

     

       105
       105
       -
       

     

       106
       106
       -
       let undo_status_of_string = function

     

       107
       107
       -
         | "pending" -> Pending

     

       108
       108
       -
         | "final" -> Final

     

       109
       109
       -
         | "canceled" -> Canceled

     

       110
       110
       -
         | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown undo status: %s" s

     

       111
       111
       -
       

     

       112
       112
       -
       let undo_status_jsont =

     

       113
       113
       -
         Jsont.map ~kind:"UndoStatus"

     

       114
       114
       -
           ~dec:undo_status_of_string ~enc:undo_status_to_string Jsont.string

     

       115
       115
       -
       

     

       116
       116
       -
       type t = {

     

       117
       117
       -
         id : Jmap_proto.Id.t;

     

       118
       118
       -
         identity_id : Jmap_proto.Id.t;

     

       119
       119
       -
         email_id : Jmap_proto.Id.t;

     

       120
       120
       -
         thread_id : Jmap_proto.Id.t;

     

       121
       121
       -
         envelope : Envelope.t option;

     

       122
       122
       -
         send_at : Ptime.t;

     

       123
       123
       -
         undo_status : undo_status;

     

       124
       124
       -
         delivery_status : (string * Delivery_status.t) list option;

     

       125
       125
       -
         dsn_blob_ids : Jmap_proto.Id.t list;

     

       126
       126
       -
         mdn_blob_ids : Jmap_proto.Id.t list;

     

       127
       127
       -
       }

     

       128
       128
       -
       

     

       129
       129
       -
       let id t = t.id

     

       130
       130
       -
       let identity_id t = t.identity_id

     

       131
       131
       -
       let email_id t = t.email_id

     

       132
       132
       -
       let thread_id t = t.thread_id

     

       133
       133
       -
       let envelope t = t.envelope

     

       134
       134
       -
       let send_at t = t.send_at

     

       135
       135
       -
       let undo_status t = t.undo_status

     

       136
       136
       -
       let delivery_status t = t.delivery_status

     

       137
       137
       -
       let dsn_blob_ids t = t.dsn_blob_ids

     

       138
       138
       -
       let mdn_blob_ids t = t.mdn_blob_ids

     

       139
       139
       -
       

     

       140
       140
       -
       let make id identity_id email_id thread_id envelope send_at undo_status

     

       141
       141
       -
           delivery_status dsn_blob_ids mdn_blob_ids =

     

       142
       142
       -
         { id; identity_id; email_id; thread_id; envelope; send_at; undo_status;

     

       143
       143
       -
           delivery_status; dsn_blob_ids; mdn_blob_ids }

     

       144
       144
       -
       

     

       145
       145
       -
       let jsont =

     

       146
       146
       -
         let kind = "EmailSubmission" in

     

       147
       147
       -
         Jsont.Object.map ~kind make

     

       148
       148
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       149
       149
       -
         |> Jsont.Object.mem "identityId" Jmap_proto.Id.jsont ~enc:identity_id

     

       150
       150
       -
         |> Jsont.Object.mem "emailId" Jmap_proto.Id.jsont ~enc:email_id

     

       151
       151
       -
         |> Jsont.Object.mem "threadId" Jmap_proto.Id.jsont ~enc:thread_id

     

       152
       152
       -
         |> Jsont.Object.opt_mem "envelope" Envelope.jsont ~enc:envelope

     

       153
       153
       -
         |> Jsont.Object.mem "sendAt" Jmap_proto.Date.Utc.jsont ~enc:send_at

     

       154
       154
       -
         |> Jsont.Object.mem "undoStatus" undo_status_jsont ~enc:undo_status

     

       155
       155
       -
         |> Jsont.Object.opt_mem "deliveryStatus" (Jmap_proto.Json_map.of_string Delivery_status.jsont) ~enc:delivery_status

     

       156
       156
       -
         |> Jsont.Object.mem "dsnBlobIds" (Jsont.list Jmap_proto.Id.jsont) ~dec_absent:[] ~enc:dsn_blob_ids

     

       157
       157
       -
         |> Jsont.Object.mem "mdnBlobIds" (Jsont.list Jmap_proto.Id.jsont) ~dec_absent:[] ~enc:mdn_blob_ids

     

       158
       158
       -
         |> Jsont.Object.finish

     

       159
       159
       -
       

     

       160
       160
       -
       module Filter_condition = struct

     

       161
       161
       -
         type t = {

     

       162
       162
       -
           identity_ids : Jmap_proto.Id.t list option;

     

       163
       163
       -
           email_ids : Jmap_proto.Id.t list option;

     

       164
       164
       -
           thread_ids : Jmap_proto.Id.t list option;

     

       165
       165
       -
           undo_status : undo_status option;

     

       166
       166
       -
           before : Ptime.t option;

     

       167
       167
       -
           after : Ptime.t option;

     

       168
       168
       -
         }

     

       169
       169
       -
       

     

       170
       170
       -
         let make identity_ids email_ids thread_ids undo_status before after =

     

       171
       171
       -
           { identity_ids; email_ids; thread_ids; undo_status; before; after }

     

       172
       172
       -
       

     

       173
       173
       -
         let jsont =

     

       174
       174
       -
           let kind = "EmailSubmissionFilterCondition" in

     

       175
       175
       -
           Jsont.Object.map ~kind make

     

       176
       176
       -
           |> Jsont.Object.opt_mem "identityIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.identity_ids)

     

       177
       177
       -
           |> Jsont.Object.opt_mem "emailIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.email_ids)

     

       178
       178
       -
           |> Jsont.Object.opt_mem "threadIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.thread_ids)

     

       179
       179
       -
           |> Jsont.Object.opt_mem "undoStatus" undo_status_jsont ~enc:(fun f -> f.undo_status)

     

       180
       180
       -
           |> Jsont.Object.opt_mem "before" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.before)

     

       181
       181
       -
           |> Jsont.Object.opt_mem "after" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.after)

     

       182
       182
       -
           |> Jsont.Object.finish

     

       183
       183
       -
       end

-132

proto/mail/submission.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** EmailSubmission type as defined in RFC 8621 Section 7 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Address} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** An address with optional SMTP parameters. *)

     

       11
       11
       -
       module Address : sig

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           email : string;

     

       14
       14
       -
           (** The email address. *)

     

       15
       15
       -
           parameters : (string * string) list option;

     

       16
       16
       -
           (** Optional SMTP parameters. *)

     

       17
       17
       -
         }

     

       18
       18
       -
       

     

       19
       19
       -
         val email : t -> string

     

       20
       20
       -
         val parameters : t -> (string * string) list option

     

       21
       21
       -
       

     

       22
       22
       -
         val jsont : t Jsont.t

     

       23
       23
       -
       end

     

       24
       24
       -
       

     

       25
       25
       -
       (** {1 Envelope} *)

     

       26
       26
       -
       

     

       27
       27
       -
       (** SMTP envelope. *)

     

       28
       28
       -
       module Envelope : sig

     

       29
       29
       -
         type t = {

     

       30
       30
       -
           mail_from : Address.t;

     

       31
       31
       -
           (** MAIL FROM address. *)

     

       32
       32
       -
           rcpt_to : Address.t list;

     

       33
       33
       -
           (** RCPT TO addresses. *)

     

       34
       34
       -
         }

     

       35
       35
       -
       

     

       36
       36
       -
         val mail_from : t -> Address.t

     

       37
       37
       -
         val rcpt_to : t -> Address.t list

     

       38
       38
       -
       

     

       39
       39
       -
         val jsont : t Jsont.t

     

       40
       40
       -
       end

     

       41
       41
       -
       

     

       42
       42
       -
       (** {1 Delivery Status} *)

     

       43
       43
       -
       

     

       44
       44
       -
       (** Status of delivery to a recipient. *)

     

       45
       45
       -
       module Delivery_status : sig

     

       46
       46
       -
         type delivered =

     

       47
       47
       -
           | Queued

     

       48
       48
       -
           | Yes

     

       49
       49
       -
           | No

     

       50
       50
       -
           | Unknown

     

       51
       51
       -
       

     

       52
       52
       -
         type displayed =

     

       53
       53
       -
           | Unknown

     

       54
       54
       -
           | Yes

     

       55
       55
       -
       

     

       56
       56
       -
         type t = {

     

       57
       57
       -
           smtp_reply : string;

     

       58
       58
       -
           (** The SMTP reply string. *)

     

       59
       59
       -
           delivered : delivered;

     

       60
       60
       -
           (** Delivery status. *)

     

       61
       61
       -
           displayed : displayed;

     

       62
       62
       -
           (** MDN display status. *)

     

       63
       63
       -
         }

     

       64
       64
       -
       

     

       65
       65
       -
         val smtp_reply : t -> string

     

       66
       66
       -
         val delivered : t -> delivered

     

       67
       67
       -
         val displayed : t -> displayed

     

       68
       68
       -
       

     

       69
       69
       -
         val jsont : t Jsont.t

     

       70
       70
       -
       end

     

       71
       71
       -
       

     

       72
       72
       -
       (** {1 Undo Status} *)

     

       73
       73
       -
       

     

       74
       74
       -
       type undo_status =

     

       75
       75
       -
         | Pending

     

       76
       76
       -
         | Final

     

       77
       77
       -
         | Canceled

     

       78
       78
       -
       

     

       79
       79
       -
       val undo_status_jsont : undo_status Jsont.t

     

       80
       80
       -
       

     

       81
       81
       -
       (** {1 EmailSubmission} *)

     

       82
       82
       -
       

     

       83
       83
       -
       type t = {

     

       84
       84
       -
         id : Jmap_proto.Id.t;

     

       85
       85
       -
         (** Server-assigned submission id. *)

     

       86
       86
       -
         identity_id : Jmap_proto.Id.t;

     

       87
       87
       -
         (** The identity used to send. *)

     

       88
       88
       -
         email_id : Jmap_proto.Id.t;

     

       89
       89
       -
         (** The email that was submitted. *)

     

       90
       90
       -
         thread_id : Jmap_proto.Id.t;

     

       91
       91
       -
         (** The thread of the submitted email. *)

     

       92
       92
       -
         envelope : Envelope.t option;

     

       93
       93
       -
         (** The envelope used, if different from email headers. *)

     

       94
       94
       -
         send_at : Ptime.t;

     

       95
       95
       -
         (** When the email was/will be sent. *)

     

       96
       96
       -
         undo_status : undo_status;

     

       97
       97
       -
         (** Whether sending can be undone. *)

     

       98
       98
       -
         delivery_status : (string * Delivery_status.t) list option;

     

       99
       99
       -
         (** Delivery status per recipient. *)

     

       100
       100
       -
         dsn_blob_ids : Jmap_proto.Id.t list;

     

       101
       101
       -
         (** Blob ids of received DSN messages. *)

     

       102
       102
       -
         mdn_blob_ids : Jmap_proto.Id.t list;

     

       103
       103
       -
         (** Blob ids of received MDN messages. *)

     

       104
       104
       -
       }

     

       105
       105
       -
       

     

       106
       106
       -
       val id : t -> Jmap_proto.Id.t

     

       107
       107
       -
       val identity_id : t -> Jmap_proto.Id.t

     

       108
       108
       -
       val email_id : t -> Jmap_proto.Id.t

     

       109
       109
       -
       val thread_id : t -> Jmap_proto.Id.t

     

       110
       110
       -
       val envelope : t -> Envelope.t option

     

       111
       111
       -
       val send_at : t -> Ptime.t

     

       112
       112
       -
       val undo_status : t -> undo_status

     

       113
       113
       -
       val delivery_status : t -> (string * Delivery_status.t) list option

     

       114
       114
       -
       val dsn_blob_ids : t -> Jmap_proto.Id.t list

     

       115
       115
       -
       val mdn_blob_ids : t -> Jmap_proto.Id.t list

     

       116
       116
       -
       

     

       117
       117
       -
       val jsont : t Jsont.t

     

       118
       118
       -
       

     

       119
       119
       -
       (** {1 Filter Conditions} *)

     

       120
       120
       -
       

     

       121
       121
       -
       module Filter_condition : sig

     

       122
       122
       -
         type t = {

     

       123
       123
       -
           identity_ids : Jmap_proto.Id.t list option;

     

       124
       124
       -
           email_ids : Jmap_proto.Id.t list option;

     

       125
       125
       -
           thread_ids : Jmap_proto.Id.t list option;

     

       126
       126
       -
           undo_status : undo_status option;

     

       127
       127
       -
           before : Ptime.t option;

     

       128
       128
       -
           after : Ptime.t option;

     

       129
       129
       -
         }

     

       130
       130
       -
       

     

       131
       131
       -
         val jsont : t Jsont.t

     

       132
       132
       -
       end

-21

proto/mail/thread.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         id : Jmap_proto.Id.t;

     

       8
       8
       -
         email_ids : Jmap_proto.Id.t list;

     

       9
       9
       -
       }

     

       10
       10
       -
       

     

       11
       11
       -
       let id t = t.id

     

       12
       12
       -
       let email_ids t = t.email_ids

     

       13
       13
       -
       

     

       14
       14
       -
       let make id email_ids = { id; email_ids }

     

       15
       15
       -
       

     

       16
       16
       -
       let jsont =

     

       17
       17
       -
         let kind = "Thread" in

     

       18
       18
       -
         Jsont.Object.map ~kind make

     

       19
       19
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       20
       20
       -
         |> Jsont.Object.mem "emailIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:email_ids

     

       21
       21
       -
         |> Jsont.Object.finish

-18

proto/mail/thread.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Thread type as defined in RFC 8621 Section 3 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         id : Jmap_proto.Id.t;

     

       10
       10
       -
         (** Server-assigned thread id. *)

     

       11
       11
       -
         email_ids : Jmap_proto.Id.t list;

     

       12
       12
       -
         (** Ids of emails in this thread, in date order. *)

     

       13
       13
       -
       }

     

       14
       14
       -
       

     

       15
       15
       -
       val id : t -> Jmap_proto.Id.t

     

       16
       16
       -
       val email_ids : t -> Jmap_proto.Id.t list

     

       17
       17
       -
       

     

       18
       18
       -
       val jsont : t Jsont.t

-39

proto/mail/vacation.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         id : Jmap_proto.Id.t;

     

       8
       8
       -
         is_enabled : bool;

     

       9
       9
       -
         from_date : Ptime.t option;

     

       10
       10
       -
         to_date : Ptime.t option;

     

       11
       11
       -
         subject : string option;

     

       12
       12
       -
         text_body : string option;

     

       13
       13
       -
         html_body : string option;

     

       14
       14
       -
       }

     

       15
       15
       -
       

     

       16
       16
       -
       let id t = t.id

     

       17
       17
       -
       let is_enabled t = t.is_enabled

     

       18
       18
       -
       let from_date t = t.from_date

     

       19
       19
       -
       let to_date t = t.to_date

     

       20
       20
       -
       let subject t = t.subject

     

       21
       21
       -
       let text_body t = t.text_body

     

       22
       22
       -
       let html_body t = t.html_body

     

       23
       23
       -
       

     

       24
       24
       -
       let singleton_id = Jmap_proto.Id.of_string_exn "singleton"

     

       25
       25
       -
       

     

       26
       26
       -
       let make id is_enabled from_date to_date subject text_body html_body =

     

       27
       27
       -
         { id; is_enabled; from_date; to_date; subject; text_body; html_body }

     

       28
       28
       -
       

     

       29
       29
       -
       let jsont =

     

       30
       30
       -
         let kind = "VacationResponse" in

     

       31
       31
       -
         Jsont.Object.map ~kind make

     

       32
       32
       -
         |> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id

     

       33
       33
       -
         |> Jsont.Object.mem "isEnabled" Jsont.bool ~enc:is_enabled

     

       34
       34
       -
         |> Jsont.Object.opt_mem "fromDate" Jmap_proto.Date.Utc.jsont ~enc:from_date

     

       35
       35
       -
         |> Jsont.Object.opt_mem "toDate" Jmap_proto.Date.Utc.jsont ~enc:to_date

     

       36
       36
       -
         |> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject

     

       37
       37
       -
         |> Jsont.Object.opt_mem "textBody" Jsont.string ~enc:text_body

     

       38
       38
       -
         |> Jsont.Object.opt_mem "htmlBody" Jsont.string ~enc:html_body

     

       39
       39
       -
         |> Jsont.Object.finish

-36

proto/mail/vacation.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** VacationResponse type as defined in RFC 8621 Section 8 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         id : Jmap_proto.Id.t;

     

       10
       10
       -
         (** Always "singleton" - there is only one vacation response. *)

     

       11
       11
       -
         is_enabled : bool;

     

       12
       12
       -
         (** Whether the vacation response is active. *)

     

       13
       13
       -
         from_date : Ptime.t option;

     

       14
       14
       -
         (** When to start sending responses. *)

     

       15
       15
       -
         to_date : Ptime.t option;

     

       16
       16
       -
         (** When to stop sending responses. *)

     

       17
       17
       -
         subject : string option;

     

       18
       18
       -
         (** Subject for the auto-reply. *)

     

       19
       19
       -
         text_body : string option;

     

       20
       20
       -
         (** Plain text body. *)

     

       21
       21
       -
         html_body : string option;

     

       22
       22
       -
         (** HTML body. *)

     

       23
       23
       -
       }

     

       24
       24
       -
       

     

       25
       25
       -
       val id : t -> Jmap_proto.Id.t

     

       26
       26
       -
       val is_enabled : t -> bool

     

       27
       27
       -
       val from_date : t -> Ptime.t option

     

       28
       28
       -
       val to_date : t -> Ptime.t option

     

       29
       29
       -
       val subject : t -> string option

     

       30
       30
       -
       val text_body : t -> string option

     

       31
       31
       -
       val html_body : t -> string option

     

       32
       32
       -
       

     

       33
       33
       -
       val jsont : t Jsont.t

     

       34
       34
       -
       

     

       35
       35
       -
       (** The singleton id for VacationResponse. *)

     

       36
       36
       -
       val singleton_id : Jmap_proto.Id.t

-316

proto/method_.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (* Foo/get *)

     

       7
       7
       -
       

     

       8
       8
       -
       type get_args = {

     

       9
       9
       -
         account_id : Id.t;

     

       10
       10
       -
         ids : Id.t list option;

     

       11
       11
       -
         properties : string list option;

     

       12
       12
       -
       }

     

       13
       13
       -
       

     

       14
       14
       -
       let get_args ~account_id ?ids ?properties () =

     

       15
       15
       -
         { account_id; ids; properties }

     

       16
       16
       -
       

     

       17
       17
       -
       let get_args_make account_id ids properties =

     

       18
       18
       -
         { account_id; ids; properties }

     

       19
       19
       -
       

     

       20
       20
       -
       let get_args_jsont =

     

       21
       21
       -
         let kind = "GetArgs" in

     

       22
       22
       -
         Jsont.Object.map ~kind get_args_make

     

       23
       23
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       24
       24
       -
         |> Jsont.Object.opt_mem "ids" (Jsont.list Id.jsont) ~enc:(fun a -> a.ids)

     

       25
       25
       -
         |> Jsont.Object.opt_mem "properties" (Jsont.list Jsont.string) ~enc:(fun a -> a.properties)

     

       26
       26
       -
         |> Jsont.Object.finish

     

       27
       27
       -
       

     

       28
       28
       -
       type 'a get_response = {

     

       29
       29
       -
         account_id : Id.t;

     

       30
       30
       -
         state : string;

     

       31
       31
       -
         list : 'a list;

     

       32
       32
       -
         not_found : Id.t list;

     

       33
       33
       -
       }

     

       34
       34
       -
       

     

       35
       35
       -
       let get_response_jsont (type a) (obj_jsont : a Jsont.t) : a get_response Jsont.t =

     

       36
       36
       -
         let kind = "GetResponse" in

     

       37
       37
       -
         let make account_id state list not_found =

     

       38
       38
       -
           { account_id; state; list; not_found }

     

       39
       39
       -
         in

     

       40
       40
       -
         Jsont.Object.map ~kind make

     

       41
       41
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       42
       42
       -
         |> Jsont.Object.mem "state" Jsont.string ~enc:(fun r -> r.state)

     

       43
       43
       -
         |> Jsont.Object.mem "list" (Jsont.list obj_jsont) ~enc:(fun r -> r.list)

     

       44
       44
       -
         |> Jsont.Object.mem "notFound" (Jsont.list Id.jsont) ~enc:(fun r -> r.not_found)

     

       45
       45
       -
         |> Jsont.Object.finish

     

       46
       46
       -
       

     

       47
       47
       -
       (* Foo/changes *)

     

       48
       48
       -
       

     

       49
       49
       -
       type changes_args = {

     

       50
       50
       -
         account_id : Id.t;

     

       51
       51
       -
         since_state : string;

     

       52
       52
       -
         max_changes : int64 option;

     

       53
       53
       -
       }

     

       54
       54
       -
       

     

       55
       55
       -
       let changes_args ~account_id ~since_state ?max_changes () =

     

       56
       56
       -
         { account_id; since_state; max_changes }

     

       57
       57
       -
       

     

       58
       58
       -
       let changes_args_make account_id since_state max_changes =

     

       59
       59
       -
         { account_id; since_state; max_changes }

     

       60
       60
       -
       

     

       61
       61
       -
       let changes_args_jsont =

     

       62
       62
       -
         let kind = "ChangesArgs" in

     

       63
       63
       -
         Jsont.Object.map ~kind changes_args_make

     

       64
       64
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       65
       65
       -
         |> Jsont.Object.mem "sinceState" Jsont.string ~enc:(fun a -> a.since_state)

     

       66
       66
       -
         |> Jsont.Object.opt_mem "maxChanges" Int53.Unsigned.jsont ~enc:(fun a -> a.max_changes)

     

       67
       67
       -
         |> Jsont.Object.finish

     

       68
       68
       -
       

     

       69
       69
       -
       type changes_response = {

     

       70
       70
       -
         account_id : Id.t;

     

       71
       71
       -
         old_state : string;

     

       72
       72
       -
         new_state : string;

     

       73
       73
       -
         has_more_changes : bool;

     

       74
       74
       -
         created : Id.t list;

     

       75
       75
       -
         updated : Id.t list;

     

       76
       76
       -
         destroyed : Id.t list;

     

       77
       77
       -
       }

     

       78
       78
       -
       

     

       79
       79
       -
       let changes_response_make account_id old_state new_state has_more_changes

     

       80
       80
       -
           created updated destroyed =

     

       81
       81
       -
         { account_id; old_state; new_state; has_more_changes; created; updated; destroyed }

     

       82
       82
       -
       

     

       83
       83
       -
       let changes_response_jsont =

     

       84
       84
       -
         let kind = "ChangesResponse" in

     

       85
       85
       -
         Jsont.Object.map ~kind changes_response_make

     

       86
       86
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       87
       87
       -
         |> Jsont.Object.mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)

     

       88
       88
       -
         |> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)

     

       89
       89
       -
         |> Jsont.Object.mem "hasMoreChanges" Jsont.bool ~enc:(fun r -> r.has_more_changes)

     

       90
       90
       -
         |> Jsont.Object.mem "created" (Jsont.list Id.jsont) ~enc:(fun r -> r.created)

     

       91
       91
       -
         |> Jsont.Object.mem "updated" (Jsont.list Id.jsont) ~enc:(fun r -> r.updated)

     

       92
       92
       -
         |> Jsont.Object.mem "destroyed" (Jsont.list Id.jsont) ~enc:(fun r -> r.destroyed)

     

       93
       93
       -
         |> Jsont.Object.finish

     

       94
       94
       -
       

     

       95
       95
       -
       (* Foo/set *)

     

       96
       96
       -
       

     

       97
       97
       -
       type 'a set_args = {

     

       98
       98
       -
         account_id : Id.t;

     

       99
       99
       -
         if_in_state : string option;

     

       100
       100
       -
         create : (Id.t * 'a) list option;

     

       101
       101
       -
         update : (Id.t * Jsont.json) list option;

     

       102
       102
       -
         destroy : Id.t list option;

     

       103
       103
       -
       }

     

       104
       104
       -
       

     

       105
       105
       -
       let set_args ~account_id ?if_in_state ?create ?update ?destroy () =

     

       106
       106
       -
         { account_id; if_in_state; create; update; destroy }

     

       107
       107
       -
       

     

       108
       108
       -
       let set_args_jsont (type a) (obj_jsont : a Jsont.t) : a set_args Jsont.t =

     

       109
       109
       -
         let kind = "SetArgs" in

     

       110
       110
       -
         let make account_id if_in_state create update destroy =

     

       111
       111
       -
           { account_id; if_in_state; create; update; destroy }

     

       112
       112
       -
         in

     

       113
       113
       -
         Jsont.Object.map ~kind make

     

       114
       114
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       115
       115
       -
         |> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)

     

       116
       116
       -
         |> Jsont.Object.opt_mem "create" (Json_map.of_id obj_jsont) ~enc:(fun a -> a.create)

     

       117
       117
       -
         |> Jsont.Object.opt_mem "update" (Json_map.of_id Jsont.json) ~enc:(fun a -> a.update)

     

       118
       118
       -
         |> Jsont.Object.opt_mem "destroy" (Jsont.list Id.jsont) ~enc:(fun a -> a.destroy)

     

       119
       119
       -
         |> Jsont.Object.finish

     

       120
       120
       -
       

     

       121
       121
       -
       type 'a set_response = {

     

       122
       122
       -
         account_id : Id.t;

     

       123
       123
       -
         old_state : string option;

     

       124
       124
       -
         new_state : string;

     

       125
       125
       -
         created : (Id.t * 'a) list option;

     

       126
       126
       -
         updated : (Id.t * 'a option) list option;

     

       127
       127
       -
         destroyed : Id.t list option;

     

       128
       128
       -
         not_created : (Id.t * Error.set_error) list option;

     

       129
       129
       -
         not_updated : (Id.t * Error.set_error) list option;

     

       130
       130
       -
         not_destroyed : (Id.t * Error.set_error) list option;

     

       131
       131
       -
       }

     

       132
       132
       -
       

     

       133
       133
       -
       let set_response_jsont (type a) (obj_jsont : a Jsont.t) : a set_response Jsont.t =

     

       134
       134
       -
         let kind = "SetResponse" in

     

       135
       135
       -
         let make account_id old_state new_state created updated destroyed

     

       136
       136
       -
             not_created not_updated not_destroyed =

     

       137
       137
       -
           { account_id; old_state; new_state; created; updated; destroyed;

     

       138
       138
       -
             not_created; not_updated; not_destroyed }

     

       139
       139
       -
         in

     

       140
       140
       -
         (* For updated values, the server may return null or an object *)

     

       141
       141
       -
         let nullable_obj = Jsont.(some obj_jsont) in

     

       142
       142
       -
         Jsont.Object.map ~kind make

     

       143
       143
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       144
       144
       -
         |> Jsont.Object.opt_mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)

     

       145
       145
       -
         |> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)

     

       146
       146
       -
         |> Jsont.Object.opt_mem "created" (Json_map.of_id obj_jsont) ~enc:(fun r -> r.created)

     

       147
       147
       -
         |> Jsont.Object.opt_mem "updated" (Json_map.of_id nullable_obj) ~enc:(fun r -> r.updated)

     

       148
       148
       -
         |> Jsont.Object.opt_mem "destroyed" (Jsont.list Id.jsont) ~enc:(fun r -> r.destroyed)

     

       149
       149
       -
         |> Jsont.Object.opt_mem "notCreated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_created)

     

       150
       150
       -
         |> Jsont.Object.opt_mem "notUpdated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_updated)

     

       151
       151
       -
         |> Jsont.Object.opt_mem "notDestroyed" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_destroyed)

     

       152
       152
       -
         |> Jsont.Object.finish

     

       153
       153
       -
       

     

       154
       154
       -
       (* Foo/copy *)

     

       155
       155
       -
       

     

       156
       156
       -
       type 'a copy_args = {

     

       157
       157
       -
         from_account_id : Id.t;

     

       158
       158
       -
         if_from_in_state : string option;

     

       159
       159
       -
         account_id : Id.t;

     

       160
       160
       -
         if_in_state : string option;

     

       161
       161
       -
         create : (Id.t * 'a) list;

     

       162
       162
       -
         on_success_destroy_original : bool;

     

       163
       163
       -
         destroy_from_if_in_state : string option;

     

       164
       164
       -
       }

     

       165
       165
       -
       

     

       166
       166
       -
       let copy_args_jsont (type a) (obj_jsont : a Jsont.t) : a copy_args Jsont.t =

     

       167
       167
       -
         let kind = "CopyArgs" in

     

       168
       168
       -
         let make from_account_id if_from_in_state account_id if_in_state create

     

       169
       169
       -
             on_success_destroy_original destroy_from_if_in_state =

     

       170
       170
       -
           { from_account_id; if_from_in_state; account_id; if_in_state; create;

     

       171
       171
       -
             on_success_destroy_original; destroy_from_if_in_state }

     

       172
       172
       -
         in

     

       173
       173
       -
         Jsont.Object.map ~kind make

     

       174
       174
       -
         |> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun a -> a.from_account_id)

     

       175
       175
       -
         |> Jsont.Object.opt_mem "ifFromInState" Jsont.string ~enc:(fun a -> a.if_from_in_state)

     

       176
       176
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       177
       177
       -
         |> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)

     

       178
       178
       -
         |> Jsont.Object.mem "create" (Json_map.of_id obj_jsont) ~enc:(fun a -> a.create)

     

       179
       179
       -
         |> Jsont.Object.mem "onSuccessDestroyOriginal" Jsont.bool ~dec_absent:false

     

       180
       180
       -
              ~enc:(fun a -> a.on_success_destroy_original)

     

       181
       181
       -
              ~enc_omit:(fun b -> not b)

     

       182
       182
       -
         |> Jsont.Object.opt_mem "destroyFromIfInState" Jsont.string ~enc:(fun a -> a.destroy_from_if_in_state)

     

       183
       183
       -
         |> Jsont.Object.finish

     

       184
       184
       -
       

     

       185
       185
       -
       type 'a copy_response = {

     

       186
       186
       -
         from_account_id : Id.t;

     

       187
       187
       -
         account_id : Id.t;

     

       188
       188
       -
         old_state : string option;

     

       189
       189
       -
         new_state : string;

     

       190
       190
       -
         created : (Id.t * 'a) list option;

     

       191
       191
       -
         not_created : (Id.t * Error.set_error) list option;

     

       192
       192
       -
       }

     

       193
       193
       -
       

     

       194
       194
       -
       let copy_response_jsont (type a) (obj_jsont : a Jsont.t) : a copy_response Jsont.t =

     

       195
       195
       -
         let kind = "CopyResponse" in

     

       196
       196
       -
         let make from_account_id account_id old_state new_state created not_created =

     

       197
       197
       -
           { from_account_id; account_id; old_state; new_state; created; not_created }

     

       198
       198
       -
         in

     

       199
       199
       -
         Jsont.Object.map ~kind make

     

       200
       200
       -
         |> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun r -> r.from_account_id)

     

       201
       201
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       202
       202
       -
         |> Jsont.Object.opt_mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)

     

       203
       203
       -
         |> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)

     

       204
       204
       -
         |> Jsont.Object.opt_mem "created" (Json_map.of_id obj_jsont) ~enc:(fun r -> r.created)

     

       205
       205
       -
         |> Jsont.Object.opt_mem "notCreated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_created)

     

       206
       206
       -
         |> Jsont.Object.finish

     

       207
       207
       -
       

     

       208
       208
       -
       (* Foo/query *)

     

       209
       209
       -
       

     

       210
       210
       -
       type 'filter query_args = {

     

       211
       211
       -
         account_id : Id.t;

     

       212
       212
       -
         filter : 'filter Filter.filter option;

     

       213
       213
       -
         sort : Filter.comparator list option;

     

       214
       214
       -
         position : int64;

     

       215
       215
       -
         anchor : Id.t option;

     

       216
       216
       -
         anchor_offset : int64;

     

       217
       217
       -
         limit : int64 option;

     

       218
       218
       -
         calculate_total : bool;

     

       219
       219
       -
       }

     

       220
       220
       -
       

     

       221
       221
       -
       let query_args ~account_id ?filter ?sort ?(position = 0L) ?anchor

     

       222
       222
       -
           ?(anchor_offset = 0L) ?limit ?(calculate_total = false) () =

     

       223
       223
       -
         { account_id; filter; sort; position; anchor; anchor_offset; limit; calculate_total }

     

       224
       224
       -
       

     

       225
       225
       -
       let query_args_jsont (type f) (filter_cond_jsont : f Jsont.t) : f query_args Jsont.t =

     

       226
       226
       -
         let kind = "QueryArgs" in

     

       227
       227
       -
         let make account_id filter sort position anchor anchor_offset limit calculate_total =

     

       228
       228
       -
           { account_id; filter; sort; position; anchor; anchor_offset; limit; calculate_total }

     

       229
       229
       -
         in

     

       230
       230
       -
         Jsont.Object.map ~kind make

     

       231
       231
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       232
       232
       -
         |> Jsont.Object.opt_mem "filter" (Filter.filter_jsont filter_cond_jsont) ~enc:(fun a -> a.filter)

     

       233
       233
       -
         |> Jsont.Object.opt_mem "sort" (Jsont.list Filter.comparator_jsont) ~enc:(fun a -> a.sort)

     

       234
       234
       -
         |> Jsont.Object.mem "position" Int53.Signed.jsont ~dec_absent:0L ~enc:(fun a -> a.position)

     

       235
       235
       -
              ~enc_omit:(fun p -> p = 0L)

     

       236
       236
       -
         |> Jsont.Object.opt_mem "anchor" Id.jsont ~enc:(fun a -> a.anchor)

     

       237
       237
       -
         |> Jsont.Object.mem "anchorOffset" Int53.Signed.jsont ~dec_absent:0L ~enc:(fun a -> a.anchor_offset)

     

       238
       238
       -
              ~enc_omit:(fun o -> o = 0L)

     

       239
       239
       -
         |> Jsont.Object.opt_mem "limit" Int53.Unsigned.jsont ~enc:(fun a -> a.limit)

     

       240
       240
       -
         |> Jsont.Object.mem "calculateTotal" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.calculate_total)

     

       241
       241
       -
              ~enc_omit:(fun b -> not b)

     

       242
       242
       -
         |> Jsont.Object.finish

     

       243
       243
       -
       

     

       244
       244
       -
       type query_response = {

     

       245
       245
       -
         account_id : Id.t;

     

       246
       246
       -
         query_state : string;

     

       247
       247
       -
         can_calculate_changes : bool;

     

       248
       248
       -
         position : int64;

     

       249
       249
       -
         ids : Id.t list;

     

       250
       250
       -
         total : int64 option;

     

       251
       251
       -
       }

     

       252
       252
       -
       

     

       253
       253
       -
       let query_response_make account_id query_state can_calculate_changes position ids total =

     

       254
       254
       -
         { account_id; query_state; can_calculate_changes; position; ids; total }

     

       255
       255
       -
       

     

       256
       256
       -
       let query_response_jsont =

     

       257
       257
       -
         let kind = "QueryResponse" in

     

       258
       258
       -
         Jsont.Object.map ~kind query_response_make

     

       259
       259
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       260
       260
       -
         |> Jsont.Object.mem "queryState" Jsont.string ~enc:(fun r -> r.query_state)

     

       261
       261
       -
         |> Jsont.Object.mem "canCalculateChanges" Jsont.bool ~enc:(fun r -> r.can_calculate_changes)

     

       262
       262
       -
         |> Jsont.Object.mem "position" Int53.Unsigned.jsont ~enc:(fun r -> r.position)

     

       263
       263
       -
         |> Jsont.Object.mem "ids" (Jsont.list Id.jsont) ~enc:(fun r -> r.ids)

     

       264
       264
       -
         |> Jsont.Object.opt_mem "total" Int53.Unsigned.jsont ~enc:(fun r -> r.total)

     

       265
       265
       -
         |> Jsont.Object.finish

     

       266
       266
       -
       

     

       267
       267
       -
       (* Foo/queryChanges *)

     

       268
       268
       -
       

     

       269
       269
       -
       type 'filter query_changes_args = {

     

       270
       270
       -
         account_id : Id.t;

     

       271
       271
       -
         filter : 'filter Filter.filter option;

     

       272
       272
       -
         sort : Filter.comparator list option;

     

       273
       273
       -
         since_query_state : string;

     

       274
       274
       -
         max_changes : int64 option;

     

       275
       275
       -
         up_to_id : Id.t option;

     

       276
       276
       -
         calculate_total : bool;

     

       277
       277
       -
       }

     

       278
       278
       -
       

     

       279
       279
       -
       let query_changes_args_jsont (type f) (filter_cond_jsont : f Jsont.t) : f query_changes_args Jsont.t =

     

       280
       280
       -
         let kind = "QueryChangesArgs" in

     

       281
       281
       -
         let make account_id filter sort since_query_state max_changes up_to_id calculate_total =

     

       282
       282
       -
           { account_id; filter; sort; since_query_state; max_changes; up_to_id; calculate_total }

     

       283
       283
       -
         in

     

       284
       284
       -
         Jsont.Object.map ~kind make

     

       285
       285
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       286
       286
       -
         |> Jsont.Object.opt_mem "filter" (Filter.filter_jsont filter_cond_jsont) ~enc:(fun a -> a.filter)

     

       287
       287
       -
         |> Jsont.Object.opt_mem "sort" (Jsont.list Filter.comparator_jsont) ~enc:(fun a -> a.sort)

     

       288
       288
       -
         |> Jsont.Object.mem "sinceQueryState" Jsont.string ~enc:(fun a -> a.since_query_state)

     

       289
       289
       -
         |> Jsont.Object.opt_mem "maxChanges" Int53.Unsigned.jsont ~enc:(fun a -> a.max_changes)

     

       290
       290
       -
         |> Jsont.Object.opt_mem "upToId" Id.jsont ~enc:(fun a -> a.up_to_id)

     

       291
       291
       -
         |> Jsont.Object.mem "calculateTotal" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.calculate_total)

     

       292
       292
       -
              ~enc_omit:(fun b -> not b)

     

       293
       293
       -
         |> Jsont.Object.finish

     

       294
       294
       -
       

     

       295
       295
       -
       type query_changes_response = {

     

       296
       296
       -
         account_id : Id.t;

     

       297
       297
       -
         old_query_state : string;

     

       298
       298
       -
         new_query_state : string;

     

       299
       299
       -
         total : int64 option;

     

       300
       300
       -
         removed : Id.t list;

     

       301
       301
       -
         added : Filter.added_item list;

     

       302
       302
       -
       }

     

       303
       303
       -
       

     

       304
       304
       -
       let query_changes_response_make account_id old_query_state new_query_state total removed added =

     

       305
       305
       -
         { account_id; old_query_state; new_query_state; total; removed; added }

     

       306
       306
       -
       

     

       307
       307
       -
       let query_changes_response_jsont =

     

       308
       308
       -
         let kind = "QueryChangesResponse" in

     

       309
       309
       -
         Jsont.Object.map ~kind query_changes_response_make

     

       310
       310
       -
         |> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)

     

       311
       311
       -
         |> Jsont.Object.mem "oldQueryState" Jsont.string ~enc:(fun r -> r.old_query_state)

     

       312
       312
       -
         |> Jsont.Object.mem "newQueryState" Jsont.string ~enc:(fun r -> r.new_query_state)

     

       313
       313
       -
         |> Jsont.Object.opt_mem "total" Int53.Unsigned.jsont ~enc:(fun r -> r.total)

     

       314
       314
       -
         |> Jsont.Object.mem "removed" (Jsont.list Id.jsont) ~enc:(fun r -> r.removed)

     

       315
       315
       -
         |> Jsont.Object.mem "added" (Jsont.list Filter.added_item_jsont) ~enc:(fun r -> r.added)

     

       316
       316
       -
         |> Jsont.Object.finish

-215

proto/method_.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP standard method types as defined in RFC 8620 Section 5 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Foo/get} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** Arguments for /get methods. *)

     

       11
       11
       -
       type get_args = {

     

       12
       12
       -
         account_id : Id.t;

     

       13
       13
       -
         (** The account to fetch from. *)

     

       14
       14
       -
         ids : Id.t list option;

     

       15
       15
       -
         (** The ids to fetch. [None] means fetch all. *)

     

       16
       16
       -
         properties : string list option;

     

       17
       17
       -
         (** Properties to include. [None] means all. *)

     

       18
       18
       -
       }

     

       19
       19
       -
       

     

       20
       20
       -
       val get_args :

     

       21
       21
       -
         account_id:Id.t ->

     

       22
       22
       -
         ?ids:Id.t list ->

     

       23
       23
       -
         ?properties:string list ->

     

       24
       24
       -
         unit ->

     

       25
       25
       -
         get_args

     

       26
       26
       -
       

     

       27
       27
       -
       val get_args_jsont : get_args Jsont.t

     

       28
       28
       -
       

     

       29
       29
       -
       (** Response for /get methods. *)

     

       30
       30
       -
       type 'a get_response = {

     

       31
       31
       -
         account_id : Id.t;

     

       32
       32
       -
         (** The account fetched from. *)

     

       33
       33
       -
         state : string;

     

       34
       34
       -
         (** Current state string. *)

     

       35
       35
       -
         list : 'a list;

     

       36
       36
       -
         (** The objects fetched. *)

     

       37
       37
       -
         not_found : Id.t list;

     

       38
       38
       -
         (** Ids that were not found. *)

     

       39
       39
       -
       }

     

       40
       40
       -
       

     

       41
       41
       -
       val get_response_jsont : 'a Jsont.t -> 'a get_response Jsont.t

     

       42
       42
       -
       

     

       43
       43
       -
       (** {1 Foo/changes} *)

     

       44
       44
       -
       

     

       45
       45
       -
       (** Arguments for /changes methods. *)

     

       46
       46
       -
       type changes_args = {

     

       47
       47
       -
         account_id : Id.t;

     

       48
       48
       -
         since_state : string;

     

       49
       49
       -
         max_changes : int64 option;

     

       50
       50
       -
       }

     

       51
       51
       -
       

     

       52
       52
       -
       val changes_args :

     

       53
       53
       -
         account_id:Id.t ->

     

       54
       54
       -
         since_state:string ->

     

       55
       55
       -
         ?max_changes:int64 ->

     

       56
       56
       -
         unit ->

     

       57
       57
       -
         changes_args

     

       58
       58
       -
       

     

       59
       59
       -
       val changes_args_jsont : changes_args Jsont.t

     

       60
       60
       -
       

     

       61
       61
       -
       (** Response for /changes methods. *)

     

       62
       62
       -
       type changes_response = {

     

       63
       63
       -
         account_id : Id.t;

     

       64
       64
       -
         old_state : string;

     

       65
       65
       -
         new_state : string;

     

       66
       66
       -
         has_more_changes : bool;

     

       67
       67
       -
         created : Id.t list;

     

       68
       68
       -
         updated : Id.t list;

     

       69
       69
       -
         destroyed : Id.t list;

     

       70
       70
       -
       }

     

       71
       71
       -
       

     

       72
       72
       -
       val changes_response_jsont : changes_response Jsont.t

     

       73
       73
       -
       

     

       74
       74
       -
       (** {1 Foo/set} *)

     

       75
       75
       -
       

     

       76
       76
       -
       (** Arguments for /set methods.

     

       77
       77
       -
       

     

       78
       78
       -
           The ['a] type parameter is the object type being created/updated. *)

     

       79
       79
       -
       type 'a set_args = {

     

       80
       80
       -
         account_id : Id.t;

     

       81
       81
       -
         if_in_state : string option;

     

       82
       82
       -
         (** If set, only apply if current state matches. *)

     

       83
       83
       -
         create : (Id.t * 'a) list option;

     

       84
       84
       -
         (** Objects to create, keyed by temporary id. *)

     

       85
       85
       -
         update : (Id.t * Jsont.json) list option;

     

       86
       86
       -
         (** Objects to update. Value is a PatchObject. *)

     

       87
       87
       -
         destroy : Id.t list option;

     

       88
       88
       -
         (** Ids to destroy. *)

     

       89
       89
       -
       }

     

       90
       90
       -
       

     

       91
       91
       -
       val set_args :

     

       92
       92
       -
         account_id:Id.t ->

     

       93
       93
       -
         ?if_in_state:string ->

     

       94
       94
       -
         ?create:(Id.t * 'a) list ->

     

       95
       95
       -
         ?update:(Id.t * Jsont.json) list ->

     

       96
       96
       -
         ?destroy:Id.t list ->

     

       97
       97
       -
         unit ->

     

       98
       98
       -
         'a set_args

     

       99
       99
       -
       

     

       100
       100
       -
       val set_args_jsont : 'a Jsont.t -> 'a set_args Jsont.t

     

       101
       101
       -
       

     

       102
       102
       -
       (** Response for /set methods. *)

     

       103
       103
       -
       type 'a set_response = {

     

       104
       104
       -
         account_id : Id.t;

     

       105
       105
       -
         old_state : string option;

     

       106
       106
       -
         new_state : string;

     

       107
       107
       -
         created : (Id.t * 'a) list option;

     

       108
       108
       -
         (** Successfully created objects, keyed by temporary id. *)

     

       109
       109
       -
         updated : (Id.t * 'a option) list option;

     

       110
       110
       -
         (** Successfully updated objects. Value may include server-set properties. *)

     

       111
       111
       -
         destroyed : Id.t list option;

     

       112
       112
       -
         (** Successfully destroyed ids. *)

     

       113
       113
       -
         not_created : (Id.t * Error.set_error) list option;

     

       114
       114
       -
         (** Failed creates. *)

     

       115
       115
       -
         not_updated : (Id.t * Error.set_error) list option;

     

       116
       116
       -
         (** Failed updates. *)

     

       117
       117
       -
         not_destroyed : (Id.t * Error.set_error) list option;

     

       118
       118
       -
         (** Failed destroys. *)

     

       119
       119
       -
       }

     

       120
       120
       -
       

     

       121
       121
       -
       val set_response_jsont : 'a Jsont.t -> 'a set_response Jsont.t

     

       122
       122
       -
       

     

       123
       123
       -
       (** {1 Foo/copy} *)

     

       124
       124
       -
       

     

       125
       125
       -
       (** Arguments for /copy methods. *)

     

       126
       126
       -
       type 'a copy_args = {

     

       127
       127
       -
         from_account_id : Id.t;

     

       128
       128
       -
         if_from_in_state : string option;

     

       129
       129
       -
         account_id : Id.t;

     

       130
       130
       -
         if_in_state : string option;

     

       131
       131
       -
         create : (Id.t * 'a) list;

     

       132
       132
       -
         on_success_destroy_original : bool;

     

       133
       133
       -
         destroy_from_if_in_state : string option;

     

       134
       134
       -
       }

     

       135
       135
       -
       

     

       136
       136
       -
       val copy_args_jsont : 'a Jsont.t -> 'a copy_args Jsont.t

     

       137
       137
       -
       

     

       138
       138
       -
       (** Response for /copy methods. *)

     

       139
       139
       -
       type 'a copy_response = {

     

       140
       140
       -
         from_account_id : Id.t;

     

       141
       141
       -
         account_id : Id.t;

     

       142
       142
       -
         old_state : string option;

     

       143
       143
       -
         new_state : string;

     

       144
       144
       -
         created : (Id.t * 'a) list option;

     

       145
       145
       -
         not_created : (Id.t * Error.set_error) list option;

     

       146
       146
       -
       }

     

       147
       147
       -
       

     

       148
       148
       -
       val copy_response_jsont : 'a Jsont.t -> 'a copy_response Jsont.t

     

       149
       149
       -
       

     

       150
       150
       -
       (** {1 Foo/query} *)

     

       151
       151
       -
       

     

       152
       152
       -
       (** Arguments for /query methods. *)

     

       153
       153
       -
       type 'filter query_args = {

     

       154
       154
       -
         account_id : Id.t;

     

       155
       155
       -
         filter : 'filter Filter.filter option;

     

       156
       156
       -
         sort : Filter.comparator list option;

     

       157
       157
       -
         position : int64;

     

       158
       158
       -
         anchor : Id.t option;

     

       159
       159
       -
         anchor_offset : int64;

     

       160
       160
       -
         limit : int64 option;

     

       161
       161
       -
         calculate_total : bool;

     

       162
       162
       -
       }

     

       163
       163
       -
       

     

       164
       164
       -
       val query_args :

     

       165
       165
       -
         account_id:Id.t ->

     

       166
       166
       -
         ?filter:'filter Filter.filter ->

     

       167
       167
       -
         ?sort:Filter.comparator list ->

     

       168
       168
       -
         ?position:int64 ->

     

       169
       169
       -
         ?anchor:Id.t ->

     

       170
       170
       -
         ?anchor_offset:int64 ->

     

       171
       171
       -
         ?limit:int64 ->

     

       172
       172
       -
         ?calculate_total:bool ->

     

       173
       173
       -
         unit ->

     

       174
       174
       -
         'filter query_args

     

       175
       175
       -
       

     

       176
       176
       -
       val query_args_jsont : 'filter Jsont.t -> 'filter query_args Jsont.t

     

       177
       177
       -
       

     

       178
       178
       -
       (** Response for /query methods. *)

     

       179
       179
       -
       type query_response = {

     

       180
       180
       -
         account_id : Id.t;

     

       181
       181
       -
         query_state : string;

     

       182
       182
       -
         can_calculate_changes : bool;

     

       183
       183
       -
         position : int64;

     

       184
       184
       -
         ids : Id.t list;

     

       185
       185
       -
         total : int64 option;

     

       186
       186
       -
       }

     

       187
       187
       -
       

     

       188
       188
       -
       val query_response_jsont : query_response Jsont.t

     

       189
       189
       -
       

     

       190
       190
       -
       (** {1 Foo/queryChanges} *)

     

       191
       191
       -
       

     

       192
       192
       -
       (** Arguments for /queryChanges methods. *)

     

       193
       193
       -
       type 'filter query_changes_args = {

     

       194
       194
       -
         account_id : Id.t;

     

       195
       195
       -
         filter : 'filter Filter.filter option;

     

       196
       196
       -
         sort : Filter.comparator list option;

     

       197
       197
       -
         since_query_state : string;

     

       198
       198
       -
         max_changes : int64 option;

     

       199
       199
       -
         up_to_id : Id.t option;

     

       200
       200
       -
         calculate_total : bool;

     

       201
       201
       -
       }

     

       202
       202
       -
       

     

       203
       203
       -
       val query_changes_args_jsont : 'filter Jsont.t -> 'filter query_changes_args Jsont.t

     

       204
       204
       -
       

     

       205
       205
       -
       (** Response for /queryChanges methods. *)

     

       206
       206
       -
       type query_changes_response = {

     

       207
       207
       -
         account_id : Id.t;

     

       208
       208
       -
         old_query_state : string;

     

       209
       209
       -
         new_query_state : string;

     

       210
       210
       -
         total : int64 option;

     

       211
       211
       -
         removed : Id.t list;

     

       212
       212
       -
         added : Filter.added_item list;

     

       213
       213
       -
       }

     

       214
       214
       -
       

     

       215
       215
       -
       val query_changes_response_jsont : query_changes_response Jsont.t

-132

proto/push.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module State_change = struct

     

       7
       7
       -
         type type_state = {

     

       8
       8
       -
           type_name : string;

     

       9
       9
       -
           state : string;

     

       10
       10
       -
         }

     

       11
       11
       -
       

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           type_ : string;

     

       14
       14
       -
           changed : (Id.t * type_state list) list;

     

       15
       15
       -
         }

     

       16
       16
       -
       

     

       17
       17
       -
         (* The changed object is account_id -> { typeName: state } *)

     

       18
       18
       -
         let changed_jsont =

     

       19
       19
       -
           let kind = "Changed" in

     

       20
       20
       -
           (* Inner is type -> state string map *)

     

       21
       21
       -
           let type_states_jsont = Json_map.of_string Jsont.string in

     

       22
       22
       -
           (* Convert list of (string * string) to type_state list *)

     

       23
       23
       -
           let decode_type_states pairs =

     

       24
       24
       -
             List.map (fun (type_name, state) -> { type_name; state }) pairs

     

       25
       25
       -
           in

     

       26
       26
       -
           let encode_type_states states =

     

       27
       27
       -
             List.map (fun ts -> (ts.type_name, ts.state)) states

     

       28
       28
       -
           in

     

       29
       29
       -
           Json_map.of_id

     

       30
       30
       -
             (Jsont.map ~kind ~dec:decode_type_states ~enc:encode_type_states type_states_jsont)

     

       31
       31
       -
       

     

       32
       32
       -
         let make type_ changed = { type_; changed }

     

       33
       33
       -
       

     

       34
       34
       -
         let jsont =

     

       35
       35
       -
           let kind = "StateChange" in

     

       36
       36
       -
           Jsont.Object.map ~kind make

     

       37
       37
       -
           |> Jsont.Object.mem "@type" Jsont.string ~enc:(fun t -> t.type_)

     

       38
       38
       -
           |> Jsont.Object.mem "changed" changed_jsont ~enc:(fun t -> t.changed)

     

       39
       39
       -
           |> Jsont.Object.finish

     

       40
       40
       -
       end

     

       41
       41
       -
       

     

       42
       42
       -
       type push_keys = {

     

       43
       43
       -
         p256dh : string;

     

       44
       44
       -
         auth : string;

     

       45
       45
       -
       }

     

       46
       46
       -
       

     

       47
       47
       -
       let push_keys_make p256dh auth = { p256dh; auth }

     

       48
       48
       -
       

     

       49
       49
       -
       let push_keys_jsont =

     

       50
       50
       -
         let kind = "PushKeys" in

     

       51
       51
       -
         Jsont.Object.map ~kind push_keys_make

     

       52
       52
       -
         |> Jsont.Object.mem "p256dh" Jsont.string ~enc:(fun k -> k.p256dh)

     

       53
       53
       -
         |> Jsont.Object.mem "auth" Jsont.string ~enc:(fun k -> k.auth)

     

       54
       54
       -
         |> Jsont.Object.finish

     

       55
       55
       -
       

     

       56
       56
       -
       type t = {

     

       57
       57
       -
         id : Id.t;

     

       58
       58
       -
         device_client_id : string;

     

       59
       59
       -
         url : string;

     

       60
       60
       -
         keys : push_keys option;

     

       61
       61
       -
         verification_code : string option;

     

       62
       62
       -
         expires : Ptime.t option;

     

       63
       63
       -
         types : string list option;

     

       64
       64
       -
       }

     

       65
       65
       -
       

     

       66
       66
       -
       let id t = t.id

     

       67
       67
       -
       let device_client_id t = t.device_client_id

     

       68
       68
       -
       let url t = t.url

     

       69
       69
       -
       let keys t = t.keys

     

       70
       70
       -
       let verification_code t = t.verification_code

     

       71
       71
       -
       let expires t = t.expires

     

       72
       72
       -
       let types t = t.types

     

       73
       73
       -
       

     

       74
       74
       -
       let make id device_client_id url keys verification_code expires types =

     

       75
       75
       -
         { id; device_client_id; url; keys; verification_code; expires; types }

     

       76
       76
       -
       

     

       77
       77
       -
       let jsont =

     

       78
       78
       -
         let kind = "PushSubscription" in

     

       79
       79
       -
         Jsont.Object.map ~kind make

     

       80
       80
       -
         |> Jsont.Object.mem "id" Id.jsont ~enc:id

     

       81
       81
       -
         |> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:device_client_id

     

       82
       82
       -
         |> Jsont.Object.mem "url" Jsont.string ~enc:url

     

       83
       83
       -
         |> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:keys

     

       84
       84
       -
         |> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:verification_code

     

       85
       85
       -
         |> Jsont.Object.opt_mem "expires" Date.Utc.jsont ~enc:expires

     

       86
       86
       -
         |> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:types

     

       87
       87
       -
         |> Jsont.Object.finish

     

       88
       88
       -
       

     

       89
       89
       -
       let get_args_jsont = Method_.get_args_jsont

     

       90
       90
       -
       let get_response_jsont = Method_.get_response_jsont jsont

     

       91
       91
       -
       

     

       92
       92
       -
       type create_args = {

     

       93
       93
       -
         device_client_id : string;

     

       94
       94
       -
         url : string;

     

       95
       95
       -
         keys : push_keys option;

     

       96
       96
       -
         verification_code : string option;

     

       97
       97
       -
         types : string list option;

     

       98
       98
       -
       }

     

       99
       99
       -
       

     

       100
       100
       -
       let create_args_make device_client_id url keys verification_code types =

     

       101
       101
       -
         { device_client_id; url; keys; verification_code; types }

     

       102
       102
       -
       

     

       103
       103
       -
       let create_args_jsont =

     

       104
       104
       -
         let kind = "PushSubscription create" in

     

       105
       105
       -
         Jsont.Object.map ~kind create_args_make

     

       106
       106
       -
         |> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:(fun a -> a.device_client_id)

     

       107
       107
       -
         |> Jsont.Object.mem "url" Jsont.string ~enc:(fun a -> a.url)

     

       108
       108
       -
         |> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:(fun a -> a.keys)

     

       109
       109
       -
         |> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:(fun a -> a.verification_code)

     

       110
       110
       -
         |> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:(fun a -> a.types)

     

       111
       111
       -
         |> Jsont.Object.finish

     

       112
       112
       -
       

     

       113
       113
       -
       type set_args = {

     

       114
       114
       -
         account_id : Id.t option;

     

       115
       115
       -
         if_in_state : string option;

     

       116
       116
       -
         create : (Id.t * create_args) list option;

     

       117
       117
       -
         update : (Id.t * Jsont.json) list option;

     

       118
       118
       -
         destroy : Id.t list option;

     

       119
       119
       -
       }

     

       120
       120
       -
       

     

       121
       121
       -
       let set_args_make account_id if_in_state create update destroy =

     

       122
       122
       -
         { account_id; if_in_state; create; update; destroy }

     

       123
       123
       -
       

     

       124
       124
       -
       let set_args_jsont =

     

       125
       125
       -
         let kind = "PushSubscription/set args" in

     

       126
       126
       -
         Jsont.Object.map ~kind set_args_make

     

       127
       127
       -
         |> Jsont.Object.opt_mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)

     

       128
       128
       -
         |> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)

     

       129
       129
       -
         |> Jsont.Object.opt_mem "create" (Json_map.of_id create_args_jsont) ~enc:(fun a -> a.create)

     

       130
       130
       -
         |> Jsont.Object.opt_mem "update" (Json_map.of_id Jsont.json) ~enc:(fun a -> a.update)

     

       131
       131
       -
         |> Jsont.Object.opt_mem "destroy" (Jsont.list Id.jsont) ~enc:(fun a -> a.destroy)

     

       132
       132
       -
         |> Jsont.Object.finish

-96

proto/push.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP push types as defined in RFC 8620 Section 7 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 StateChange} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** A state change notification for push. *)

     

       11
       11
       -
       module State_change : sig

     

       12
       12
       -
         type type_state = {

     

       13
       13
       -
           type_name : string;

     

       14
       14
       -
           (** The data type that changed (e.g., "Email", "Mailbox"). *)

     

       15
       15
       -
           state : string;

     

       16
       16
       -
           (** The new state string for this type. *)

     

       17
       17
       -
         }

     

       18
       18
       -
       

     

       19
       19
       -
         type t = {

     

       20
       20
       -
           type_ : string;

     

       21
       21
       -
           (** Always "StateChange". *)

     

       22
       22
       -
           changed : (Id.t * type_state list) list;

     

       23
       23
       -
           (** Map of account id to list of type state changes. *)

     

       24
       24
       -
         }

     

       25
       25
       -
       

     

       26
       26
       -
         val jsont : t Jsont.t

     

       27
       27
       -
       end

     

       28
       28
       -
       

     

       29
       29
       -
       (** {1 PushSubscription} *)

     

       30
       30
       -
       

     

       31
       31
       -
       (** Web push subscription keys. *)

     

       32
       32
       -
       type push_keys = {

     

       33
       33
       -
         p256dh : string;

     

       34
       34
       -
         (** P-256 ECDH public key as URL-safe base64. *)

     

       35
       35
       -
         auth : string;

     

       36
       36
       -
         (** Authentication secret as URL-safe base64. *)

     

       37
       37
       -
       }

     

       38
       38
       -
       

     

       39
       39
       -
       val push_keys_jsont : push_keys Jsont.t

     

       40
       40
       -
       

     

       41
       41
       -
       (** A push subscription object. *)

     

       42
       42
       -
       type t = {

     

       43
       43
       -
         id : Id.t;

     

       44
       44
       -
         (** Server-assigned subscription id. *)

     

       45
       45
       -
         device_client_id : string;

     

       46
       46
       -
         (** Client-provided device identifier. *)

     

       47
       47
       -
         url : string;

     

       48
       48
       -
         (** The push endpoint URL. *)

     

       49
       49
       -
         keys : push_keys option;

     

       50
       50
       -
         (** Optional encryption keys for Web Push. *)

     

       51
       51
       -
         verification_code : string option;

     

       52
       52
       -
         (** Code for verifying subscription ownership. *)

     

       53
       53
       -
         expires : Ptime.t option;

     

       54
       54
       -
         (** When the subscription expires. *)

     

       55
       55
       -
         types : string list option;

     

       56
       56
       -
         (** Data types to receive notifications for. [None] means all. *)

     

       57
       57
       -
       }

     

       58
       58
       -
       

     

       59
       59
       -
       val id : t -> Id.t

     

       60
       60
       -
       val device_client_id : t -> string

     

       61
       61
       -
       val url : t -> string

     

       62
       62
       -
       val keys : t -> push_keys option

     

       63
       63
       -
       val verification_code : t -> string option

     

       64
       64
       -
       val expires : t -> Ptime.t option

     

       65
       65
       -
       val types : t -> string list option

     

       66
       66
       -
       

     

       67
       67
       -
       val jsont : t Jsont.t

     

       68
       68
       -
       (** JSON codec for PushSubscription. *)

     

       69
       69
       -
       

     

       70
       70
       -
       (** {1 PushSubscription Methods} *)

     

       71
       71
       -
       

     

       72
       72
       -
       (** Arguments for PushSubscription/get. *)

     

       73
       73
       -
       val get_args_jsont : Method_.get_args Jsont.t

     

       74
       74
       -
       

     

       75
       75
       -
       (** Response for PushSubscription/get. *)

     

       76
       76
       -
       val get_response_jsont : t Method_.get_response Jsont.t

     

       77
       77
       -
       

     

       78
       78
       -
       (** Arguments for PushSubscription/set. *)

     

       79
       79
       -
       type set_args = {

     

       80
       80
       -
         account_id : Id.t option;

     

       81
       81
       -
         (** Not used for PushSubscription. *)

     

       82
       82
       -
         if_in_state : string option;

     

       83
       83
       -
         create : (Id.t * create_args) list option;

     

       84
       84
       -
         update : (Id.t * Jsont.json) list option;

     

       85
       85
       -
         destroy : Id.t list option;

     

       86
       86
       -
       }

     

       87
       87
       -
       

     

       88
       88
       -
       and create_args = {

     

       89
       89
       -
         device_client_id : string;

     

       90
       90
       -
         url : string;

     

       91
       91
       -
         keys : push_keys option;

     

       92
       92
       -
         verification_code : string option;

     

       93
       93
       -
         types : string list option;

     

       94
       94
       -
       }

     

       95
       95
       -
       

     

       96
       96
       -
       val set_args_jsont : set_args Jsont.t

-34

proto/request.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         using : string list;

     

       8
       8
       -
         method_calls : Invocation.t list;

     

       9
       9
       -
         created_ids : (Id.t * Id.t) list option;

     

       10
       10
       -
       }

     

       11
       11
       -
       

     

       12
       12
       -
       let create ~using ~method_calls ?created_ids () =

     

       13
       13
       -
         { using; method_calls; created_ids }

     

       14
       14
       -
       

     

       15
       15
       -
       let using t = t.using

     

       16
       16
       -
       let method_calls t = t.method_calls

     

       17
       17
       -
       let created_ids t = t.created_ids

     

       18
       18
       -
       

     

       19
       19
       -
       let make using method_calls created_ids =

     

       20
       20
       -
         { using; method_calls; created_ids }

     

       21
       21
       -
       

     

       22
       22
       -
       let jsont =

     

       23
       23
       -
         let kind = "Request" in

     

       24
       24
       -
         Jsont.Object.map ~kind make

     

       25
       25
       -
         |> Jsont.Object.mem "using" (Jsont.list Jsont.string) ~enc:using

     

       26
       26
       -
         |> Jsont.Object.mem "methodCalls" (Jsont.list Invocation.jsont) ~enc:method_calls

     

       27
       27
       -
         |> Jsont.Object.opt_mem "createdIds" (Json_map.of_id Id.jsont) ~enc:created_ids

     

       28
       28
       -
         |> Jsont.Object.finish

     

       29
       29
       -
       

     

       30
       30
       -
       let single ~using invocation =

     

       31
       31
       -
         { using; method_calls = [invocation]; created_ids = None }

     

       32
       32
       -
       

     

       33
       33
       -
       let batch ~using invocations =

     

       34
       34
       -
         { using; method_calls = invocations; created_ids = None }

-45

proto/request.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP request object as defined in RFC 8620 Section 3.3 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         using : string list;

     

       10
       10
       -
         (** Capability URIs required for this request. *)

     

       11
       11
       -
         method_calls : Invocation.t list;

     

       12
       12
       -
         (** The method calls to execute. *)

     

       13
       13
       -
         created_ids : (Id.t * Id.t) list option;

     

       14
       14
       -
         (** Map of client-created temporary ids to server-assigned ids.

     

       15
       15
       -
             Used for result references in batch operations. *)

     

       16
       16
       -
       }

     

       17
       17
       -
       

     

       18
       18
       -
       val create :

     

       19
       19
       -
         using:string list ->

     

       20
       20
       -
         method_calls:Invocation.t list ->

     

       21
       21
       -
         ?created_ids:(Id.t * Id.t) list ->

     

       22
       22
       -
         unit ->

     

       23
       23
       -
         t

     

       24
       24
       -
       (** [create ~using ~method_calls ?created_ids ()] creates a JMAP request. *)

     

       25
       25
       -
       

     

       26
       26
       -
       val using : t -> string list

     

       27
       27
       -
       val method_calls : t -> Invocation.t list

     

       28
       28
       -
       val created_ids : t -> (Id.t * Id.t) list option

     

       29
       29
       -
       

     

       30
       30
       -
       val jsont : t Jsont.t

     

       31
       31
       -
       (** JSON codec for JMAP requests. *)

     

       32
       32
       -
       

     

       33
       33
       -
       (** {1 Request Builders} *)

     

       34
       34
       -
       

     

       35
       35
       -
       val single :

     

       36
       36
       -
         using:string list ->

     

       37
       37
       -
         Invocation.t ->

     

       38
       38
       -
         t

     

       39
       39
       -
       (** [single ~using invocation] creates a request with a single method call. *)

     

       40
       40
       -
       

     

       41
       41
       -
       val batch :

     

       42
       42
       -
         using:string list ->

     

       43
       43
       -
         Invocation.t list ->

     

       44
       44
       -
         t

     

       45
       45
       -
       (** [batch ~using invocations] creates a request with multiple method calls. *)

-46

proto/response.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = {

     

       7
       7
       -
         method_responses : Invocation.t list;

     

       8
       8
       -
         created_ids : (Id.t * Id.t) list option;

     

       9
       9
       -
         session_state : string;

     

       10
       10
       -
       }

     

       11
       11
       -
       

     

       12
       12
       -
       let method_responses t = t.method_responses

     

       13
       13
       -
       let created_ids t = t.created_ids

     

       14
       14
       -
       let session_state t = t.session_state

     

       15
       15
       -
       

     

       16
       16
       -
       let make method_responses created_ids session_state =

     

       17
       17
       -
         { method_responses; created_ids; session_state }

     

       18
       18
       -
       

     

       19
       19
       -
       let jsont =

     

       20
       20
       -
         let kind = "Response" in

     

       21
       21
       -
         Jsont.Object.map ~kind make

     

       22
       22
       -
         |> Jsont.Object.mem "methodResponses" (Jsont.list Invocation.jsont) ~enc:method_responses

     

       23
       23
       -
         |> Jsont.Object.opt_mem "createdIds" (Json_map.of_id Id.jsont) ~enc:created_ids

     

       24
       24
       -
         |> Jsont.Object.mem "sessionState" Jsont.string ~enc:session_state

     

       25
       25
       -
         |> Jsont.Object.finish

     

       26
       26
       -
       

     

       27
       27
       -
       let find_response method_call_id response =

     

       28
       28
       -
         List.find_opt

     

       29
       29
       -
           (fun inv -> Invocation.method_call_id inv = method_call_id)

     

       30
       30
       -
           response.method_responses

     

       31
       31
       -
       

     

       32
       32
       -
       let get_response method_call_id response =

     

       33
       33
       -
         match find_response method_call_id response with

     

       34
       34
       -
         | Some inv -> inv

     

       35
       35
       -
         | None -> raise Not_found

     

       36
       36
       -
       

     

       37
       37
       -
       let is_error invocation =

     

       38
       38
       -
         String.equal (Invocation.name invocation) "error"

     

       39
       39
       -
       

     

       40
       40
       -
       let get_error invocation =

     

       41
       41
       -
         if is_error invocation then

     

       42
       42
       -
           match Jsont.Json.decode' Error.method_error_jsont (Invocation.arguments invocation) with

     

       43
       43
       -
           | Ok v -> Some v

     

       44
       44
       -
           | Error _ -> None

     

       45
       45
       -
         else

     

       46
       46
       -
           None

-37

proto/response.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP response object as defined in RFC 8620 Section 3.4 *)

     

       7
       7
       -
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         method_responses : Invocation.t list;

     

       10
       10
       -
         (** The method responses. Each is [methodName, responseArgs, methodCallId]. *)

     

       11
       11
       -
         created_ids : (Id.t * Id.t) list option;

     

       12
       12
       -
         (** Map of client-created temporary ids to server-assigned ids. *)

     

       13
       13
       -
         session_state : string;

     

       14
       14
       -
         (** Current session state. Changes indicate session data has changed. *)

     

       15
       15
       -
       }

     

       16
       16
       -
       

     

       17
       17
       -
       val method_responses : t -> Invocation.t list

     

       18
       18
       -
       val created_ids : t -> (Id.t * Id.t) list option

     

       19
       19
       -
       val session_state : t -> string

     

       20
       20
       -
       

     

       21
       21
       -
       val jsont : t Jsont.t

     

       22
       22
       -
       (** JSON codec for JMAP responses. *)

     

       23
       23
       -
       

     

       24
       24
       -
       (** {1 Response Inspection} *)

     

       25
       25
       -
       

     

       26
       26
       -
       val find_response : string -> t -> Invocation.t option

     

       27
       27
       -
       (** [find_response method_call_id response] finds the response for a method call. *)

     

       28
       28
       -
       

     

       29
       29
       -
       val get_response : string -> t -> Invocation.t

     

       30
       30
       -
       (** [get_response method_call_id response] gets the response for a method call.

     

       31
       31
       -
           @raise Not_found if not found. *)

     

       32
       32
       -
       

     

       33
       33
       -
       val is_error : Invocation.t -> bool

     

       34
       34
       -
       (** [is_error invocation] returns [true] if the invocation is an error response. *)

     

       35
       35
       -
       

     

       36
       36
       -
       val get_error : Invocation.t -> Error.method_error option

     

       37
       37
       -
       (** [get_error invocation] returns the error if this is an error response. *)

-96

proto/session.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       module Account = struct

     

       7
       7
       -
         type t = {

     

       8
       8
       -
           name : string;

     

       9
       9
       -
           is_personal : bool;

     

       10
       10
       -
           is_read_only : bool;

     

       11
       11
       -
           account_capabilities : (string * Jsont.json) list;

     

       12
       12
       -
         }

     

       13
       13
       -
       

     

       14
       14
       -
         let name t = t.name

     

       15
       15
       -
         let is_personal t = t.is_personal

     

       16
       16
       -
         let is_read_only t = t.is_read_only

     

       17
       17
       -
         let account_capabilities t = t.account_capabilities

     

       18
       18
       -
       

     

       19
       19
       -
         let make name is_personal is_read_only account_capabilities =

     

       20
       20
       -
           { name; is_personal; is_read_only; account_capabilities }

     

       21
       21
       -
       

     

       22
       22
       -
         let jsont =

     

       23
       23
       -
           let kind = "Account" in

     

       24
       24
       -
           Jsont.Object.map ~kind make

     

       25
       25
       -
           |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       26
       26
       -
           |> Jsont.Object.mem "isPersonal" Jsont.bool ~enc:is_personal

     

       27
       27
       -
           |> Jsont.Object.mem "isReadOnly" Jsont.bool ~enc:is_read_only

     

       28
       28
       -
           |> Jsont.Object.mem "accountCapabilities" (Json_map.of_string Jsont.json) ~enc:account_capabilities

     

       29
       29
       -
           |> Jsont.Object.finish

     

       30
       30
       -
       end

     

       31
       31
       -
       

     

       32
       32
       -
       type t = {

     

       33
       33
       -
         capabilities : (string * Jsont.json) list;

     

       34
       34
       -
         accounts : (Id.t * Account.t) list;

     

       35
       35
       -
         primary_accounts : (string * Id.t) list;

     

       36
       36
       -
         username : string;

     

       37
       37
       -
         api_url : string;

     

       38
       38
       -
         download_url : string;

     

       39
       39
       -
         upload_url : string;

     

       40
       40
       -
         event_source_url : string;

     

       41
       41
       -
         state : string;

     

       42
       42
       -
       }

     

       43
       43
       -
       

     

       44
       44
       -
       let capabilities t = t.capabilities

     

       45
       45
       -
       let accounts t = t.accounts

     

       46
       46
       -
       let primary_accounts t = t.primary_accounts

     

       47
       47
       -
       let username t = t.username

     

       48
       48
       -
       let api_url t = t.api_url

     

       49
       49
       -
       let download_url t = t.download_url

     

       50
       50
       -
       let upload_url t = t.upload_url

     

       51
       51
       -
       let event_source_url t = t.event_source_url

     

       52
       52
       -
       let state t = t.state

     

       53
       53
       -
       

     

       54
       54
       -
       let make capabilities accounts primary_accounts username api_url

     

       55
       55
       -
           download_url upload_url event_source_url state =

     

       56
       56
       -
         { capabilities; accounts; primary_accounts; username; api_url;

     

       57
       57
       -
           download_url; upload_url; event_source_url; state }

     

       58
       58
       -
       

     

       59
       59
       -
       let jsont =

     

       60
       60
       -
         let kind = "Session" in

     

       61
       61
       -
         Jsont.Object.map ~kind make

     

       62
       62
       -
         |> Jsont.Object.mem "capabilities" (Json_map.of_string Jsont.json) ~enc:capabilities

     

       63
       63
       -
         |> Jsont.Object.mem "accounts" (Json_map.of_id Account.jsont) ~enc:accounts

     

       64
       64
       -
         |> Jsont.Object.mem "primaryAccounts" (Json_map.of_string Id.jsont) ~enc:primary_accounts

     

       65
       65
       -
         |> Jsont.Object.mem "username" Jsont.string ~enc:username

     

       66
       66
       -
         |> Jsont.Object.mem "apiUrl" Jsont.string ~enc:api_url

     

       67
       67
       -
         |> Jsont.Object.mem "downloadUrl" Jsont.string ~enc:download_url

     

       68
       68
       -
         |> Jsont.Object.mem "uploadUrl" Jsont.string ~enc:upload_url

     

       69
       69
       -
         |> Jsont.Object.mem "eventSourceUrl" Jsont.string ~enc:event_source_url

     

       70
       70
       -
         |> Jsont.Object.mem "state" Jsont.string ~enc:state

     

       71
       71
       -
         |> Jsont.Object.finish

     

       72
       72
       -
       

     

       73
       73
       -
       let get_account id session =

     

       74
       74
       -
         List.assoc_opt id session.accounts

     

       75
       75
       -
       

     

       76
       76
       -
       let primary_account_for capability session =

     

       77
       77
       -
         List.assoc_opt capability session.primary_accounts

     

       78
       78
       -
       

     

       79
       79
       -
       let has_capability uri session =

     

       80
       80
       -
         List.exists (fun (k, _) -> k = uri) session.capabilities

     

       81
       81
       -
       

     

       82
       82
       -
       let get_core_capability session =

     

       83
       83
       -
         match List.assoc_opt Capability.core session.capabilities with

     

       84
       84
       -
         | None -> None

     

       85
       85
       -
         | Some json ->

     

       86
       86
       -
           (match Jsont.Json.decode' Capability.Core.jsont json with

     

       87
       87
       -
            | Ok v -> Some v

     

       88
       88
       -
            | Error _ -> None)

     

       89
       89
       -
       

     

       90
       90
       -
       let get_mail_capability session =

     

       91
       91
       -
         match List.assoc_opt Capability.mail session.capabilities with

     

       92
       92
       -
         | None -> None

     

       93
       93
       -
         | Some json ->

     

       94
       94
       -
           (match Jsont.Json.decode' Capability.Mail.jsont json with

     

       95
       95
       -
            | Ok v -> Some v

     

       96
       96
       -
            | Error _ -> None)

-84

proto/session.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP session object as defined in RFC 8620 Section 2 *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Account} *)

     

       9
       9
       -
       

     

       10
       10
       -
       (** An account available to the user. *)

     

       11
       11
       -
       module Account : sig

     

       12
       12
       -
         type t = {

     

       13
       13
       -
           name : string;

     

       14
       14
       -
           (** Human-readable name for the account. *)

     

       15
       15
       -
           is_personal : bool;

     

       16
       16
       -
           (** Whether this is a personal account. *)

     

       17
       17
       -
           is_read_only : bool;

     

       18
       18
       -
           (** Whether the account is read-only. *)

     

       19
       19
       -
           account_capabilities : (string * Jsont.json) list;

     

       20
       20
       -
           (** Capabilities available for this account. *)

     

       21
       21
       -
         }

     

       22
       22
       -
       

     

       23
       23
       -
         val name : t -> string

     

       24
       24
       -
         val is_personal : t -> bool

     

       25
       25
       -
         val is_read_only : t -> bool

     

       26
       26
       -
         val account_capabilities : t -> (string * Jsont.json) list

     

       27
       27
       -
       

     

       28
       28
       -
         val jsont : t Jsont.t

     

       29
       29
       -
       end

     

       30
       30
       -
       

     

       31
       31
       -
       (** {1 Session} *)

     

       32
       32
       -
       

     

       33
       33
       -
       (** The JMAP session resource. *)

     

       34
       34
       -
       type t = {

     

       35
       35
       -
         capabilities : (string * Jsont.json) list;

     

       36
       36
       -
         (** Server capabilities. Keys are capability URIs. *)

     

       37
       37
       -
         accounts : (Id.t * Account.t) list;

     

       38
       38
       -
         (** Available accounts keyed by account id. *)

     

       39
       39
       -
         primary_accounts : (string * Id.t) list;

     

       40
       40
       -
         (** Map of capability URI to the primary account id for that capability. *)

     

       41
       41
       -
         username : string;

     

       42
       42
       -
         (** The username associated with the credentials. *)

     

       43
       43
       -
         api_url : string;

     

       44
       44
       -
         (** URL to POST JMAP requests to. *)

     

       45
       45
       -
         download_url : string;

     

       46
       46
       -
         (** URL template for downloading blobs. *)

     

       47
       47
       -
         upload_url : string;

     

       48
       48
       -
         (** URL template for uploading blobs. *)

     

       49
       49
       -
         event_source_url : string;

     

       50
       50
       -
         (** URL for push event source. *)

     

       51
       51
       -
         state : string;

     

       52
       52
       -
         (** Opaque session state string. *)

     

       53
       53
       -
       }

     

       54
       54
       -
       

     

       55
       55
       -
       val capabilities : t -> (string * Jsont.json) list

     

       56
       56
       -
       val accounts : t -> (Id.t * Account.t) list

     

       57
       57
       -
       val primary_accounts : t -> (string * Id.t) list

     

       58
       58
       -
       val username : t -> string

     

       59
       59
       -
       val api_url : t -> string

     

       60
       60
       -
       val download_url : t -> string

     

       61
       61
       -
       val upload_url : t -> string

     

       62
       62
       -
       val event_source_url : t -> string

     

       63
       63
       -
       val state : t -> string

     

       64
       64
       -
       

     

       65
       65
       -
       val jsont : t Jsont.t

     

       66
       66
       -
       (** JSON codec for session objects. *)

     

       67
       67
       -
       

     

       68
       68
       -
       (** {1 Session Helpers} *)

     

       69
       69
       -
       

     

       70
       70
       -
       val get_account : Id.t -> t -> Account.t option

     

       71
       71
       -
       (** [get_account id session] returns the account with the given id. *)

     

       72
       72
       -
       

     

       73
       73
       -
       val primary_account_for : string -> t -> Id.t option

     

       74
       74
       -
       (** [primary_account_for capability session] returns the primary account

     

       75
       75
       -
           for the given capability URI. *)

     

       76
       76
       -
       

     

       77
       77
       -
       val has_capability : string -> t -> bool

     

       78
       78
       -
       (** [has_capability uri session] returns [true] if the server supports the capability. *)

     

       79
       79
       -
       

     

       80
       80
       -
       val get_core_capability : t -> Capability.Core.t option

     

       81
       81
       -
       (** [get_core_capability session] returns the parsed core capability. *)

     

       82
       82
       -
       

     

       83
       83
       -
       val get_mail_capability : t -> Capability.Mail.t option

     

       84
       84
       -
       (** [get_mail_capability session] returns the parsed mail capability. *)

-14

proto/unknown.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       type t = Jsont.json

     

       7
       7
       -
       

     

       8
       8
       -
       let empty = Jsont.Object ([], Jsont.Meta.none)

     

       9
       9
       -
       

     

       10
       10
       -
       let is_empty = function

     

       11
       11
       -
         | Jsont.Object ([], _) -> true

     

       12
       12
       -
         | _ -> false

     

       13
       13
       -
       

     

       14
       14
       -
       let mems = Jsont.json_mems

-23

proto/unknown.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Unknown field preservation for forward compatibility.

     

       7
       7
       -
       

     

       8
       8
       -
           All JMAP objects preserve unknown fields to support future spec versions

     

       9
       9
       -
           and custom extensions. *)

     

       10
       10
       -
       

     

       11
       11
       -
       type t = Jsont.json

     

       12
       12
       -
       (** Unknown or unrecognized JSON object members as a generic JSON value.

     

       13
       13
       -
           This is always an object containing the unknown fields. *)

     

       14
       14
       -
       

     

       15
       15
       -
       val empty : t

     

       16
       16
       -
       (** [empty] is the empty set of unknown fields (an empty JSON object). *)

     

       17
       17
       -
       

     

       18
       18
       -
       val is_empty : t -> bool

     

       19
       19
       -
       (** [is_empty u] returns [true] if there are no unknown fields. *)

     

       20
       20
       -
       

     

       21
       21
       -
       val mems : (t, t, Jsont.mem list) Jsont.Object.Mems.map

     

       22
       22
       -
       (** [mems] is the jsont member map for preserving unknown fields.

     

       23
       23
       -
           Use with [Jsont.Object.keep_unknown]. *)

-10

test/proto/capability/valid/core.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "maxSizeUpload": 50000000,

     

       3
       3
       -
         "maxConcurrentUpload": 4,

     

       4
       4
       -
         "maxSizeRequest": 10000000,

     

       5
       5
       -
         "maxConcurrentRequests": 4,

     

       6
       6
       -
         "maxCallsInRequest": 16,

     

       7
       7
       -
         "maxObjectsInGet": 500,

     

       8
       8
       -
         "maxObjectsInSet": 500,

     

       9
       9
       -
         "collationAlgorithms": ["i;ascii-casemap", "i;octet"]

     

       10
       10
       -
       }

-6

test/proto/capability/valid/mail.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "maxSizeMailboxName": 490,

     

       3
       3
       -
         "maxSizeAttachmentsPerEmail": 50000000,

     

       4
       4
       -
         "emailQuerySortOptions": ["receivedAt", "sentAt", "size", "from", "to", "subject"],

     

       5
       5
       -
         "mayCreateTopLevelMailbox": true

     

       6
       6
       -
       }

-7

test/proto/capability/valid/submission.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "maxDelayedSend": 86400,

     

       3
       3
       -
         "submissionExtensions": {

     

       4
       4
       -
           "DELIVERBY": [],

     

       5
       5
       -
           "MT-PRIORITY": ["MIXER", "STANAG4406"]

     

       6
       6
       -
         }

     

       7
       7
       -
       }

-1

test/proto/date/edge/microseconds.json

···

       1
       1
       -
       2024-01-15T10:30:00.123456Z

-1

test/proto/date/edge/negative_offset.json

···

       1
       1
       -
       2024-01-15T10:30:00-08:00

-1

test/proto/date/invalid/bad_format.json

···

       1
       1
       -
       January 15, 2024

-1

test/proto/date/invalid/invalid_date.json

···

       1
       1
       -
       2024-02-30T10:30:00Z

-1

test/proto/date/invalid/lowercase_t.json

···

       1
       1
       -
       2024-01-15t10:30:00Z

-1

test/proto/date/invalid/lowercase_z.json

···

       1
       1
       -
       2024-01-15T10:30:00z

-1

test/proto/date/invalid/missing_seconds.json

···

       1
       1
       -
       2024-01-15T10:30Z

-1

test/proto/date/invalid/no_timezone.json

···

       1
       1
       -
       2024-01-15T10:30:00

-1

test/proto/date/invalid/not_string.json

-1

test/proto/date/valid/negative_offset.json

···

       1
       1
       -
       2024-01-15T10:30:00-08:00

-1

test/proto/date/valid/utc_z.json

···

       1
       1
       -
       2024-01-15T10:30:00Z

-1

test/proto/date/valid/with_milliseconds.json

···

       1
       1
       -
       2024-01-15T10:30:00.123Z

-1

test/proto/date/valid/with_offset.json

···

       1
       1
       -
       2024-01-15T10:30:00+05:30

-17

test/proto/dune

···

       1
       1
       -
       (test

     

       2
       2
       -
        (name test_proto)

     

       3
       3
       -
        (package jmap)

     

       4
       4
       -
        (libraries jmap jmap.mail alcotest jsont.bytesrw)

     

       5
       5
       -
        (deps

     

       6
       6
       -
         (source_tree id)

     

       7
       7
       -
         (source_tree int53)

     

       8
       8
       -
         (source_tree date)

     

       9
       9
       -
         (source_tree session)

     

       10
       10
       -
         (source_tree request)

     

       11
       11
       -
         (source_tree response)

     

       12
       12
       -
         (source_tree invocation)

     

       13
       13
       -
         (source_tree capability)

     

       14
       14
       -
         (source_tree filter)

     

       15
       15
       -
         (source_tree method)

     

       16
       16
       -
         (source_tree error)

     

       17
       17
       -
         (source_tree mail)))

-4

test/proto/error/valid/method_error.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "unknownMethod",

     

       3
       3
       -
         "description": "The method Foo/bar is not supported"

     

       4
       4
       -
       }

-4

test/proto/error/valid/method_error_account_not_found.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "accountNotFound",

     

       3
       3
       -
         "description": "Account with id 'acc123' does not exist"

     

       4
       4
       -
       }

-4

test/proto/error/valid/method_error_account_read_only.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "accountReadOnly",

     

       3
       3
       -
         "description": "This account does not allow modifications"

     

       4
       4
       -
       }

-4

test/proto/error/valid/method_error_forbidden.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "forbidden",

     

       3
       3
       -
         "description": "Access to this method is not permitted"

     

       4
       4
       -
       }

-4

test/proto/error/valid/method_error_invalid_arguments.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "invalidArguments",

     

       3
       3
       -
         "description": "Missing required argument: accountId"

     

       4
       4
       -
       }

-4

test/proto/error/valid/method_error_server_fail.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "serverFail",

     

       3
       3
       -
         "description": "An unexpected error occurred on the server"

     

       4
       4
       -
       }

-5

test/proto/error/valid/request_error.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "urn:ietf:params:jmap:error:notRequest",

     

       3
       3
       -
         "status": 400,

     

       4
       4
       -
         "detail": "Request body is not a valid JSON object"

     

       5
       5
       -
       }

-6

test/proto/error/valid/request_error_limit.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "urn:ietf:params:jmap:error:limit",

     

       3
       3
       -
         "status": 400,

     

       4
       4
       -
         "limit": "maxCallsInRequest",

     

       5
       5
       -
         "detail": "Too many method calls in request"

     

       6
       6
       -
       }

-5

test/proto/error/valid/request_error_not_json.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "urn:ietf:params:jmap:error:notJSON",

     

       3
       3
       -
         "status": 400,

     

       4
       4
       -
         "detail": "The request body is not valid JSON"

     

       5
       5
       -
       }

-5

test/proto/error/valid/set_error.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "invalidProperties",

     

       3
       3
       -
         "description": "The property 'foo' is not valid",

     

       4
       4
       -
         "properties": ["foo", "bar"]

     

       5
       5
       -
       }

-4

test/proto/error/valid/set_error_forbidden.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "forbidden",

     

       3
       3
       -
         "description": "You do not have permission to modify this object"

     

       4
       4
       -
       }

-5

test/proto/error/valid/set_error_invalid_properties.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "invalidProperties",

     

       3
       3
       -
         "description": "Invalid property values",

     

       4
       4
       -
         "properties": ["name", "parentId"]

     

       5
       5
       -
       }

-4

test/proto/error/valid/set_error_not_found.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "notFound",

     

       3
       3
       -
         "description": "Object with id 'abc123' not found"

     

       4
       4
       -
       }

-4

test/proto/error/valid/set_error_over_quota.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "overQuota",

     

       3
       3
       -
         "description": "Account storage quota exceeded"

     

       4
       4
       -
       }

-4

test/proto/error/valid/set_error_singleton.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "type": "singleton",

     

       3
       3
       -
         "description": "Only one VacationResponse object exists per account"

     

       4
       4
       -
       }

-4

test/proto/filter/edge/empty_conditions.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "AND",

     

       3
       3
       -
         "conditions": []

     

       4
       4
       -
       }

-7

test/proto/filter/valid/and_operator.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "AND",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {"hasKeyword": "$seen"},

     

       5
       5
       -
           {"hasKeyword": "$flagged"}

     

       6
       6
       -
         ]

     

       7
       7
       -
       }

-4

test/proto/filter/valid/comparator_descending.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "property": "receivedAt",

     

       3
       3
       -
         "isAscending": false

     

       4
       4
       -
       }

-3

test/proto/filter/valid/comparator_minimal.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "property": "size"

     

       3
       3
       -
       }

-5

test/proto/filter/valid/comparator_with_collation.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "property": "subject",

     

       3
       3
       -
         "isAscending": true,

     

       4
       4
       -
         "collation": "i;unicode-casemap"

     

       5
       5
       -
       }

-18

test/proto/filter/valid/deeply_nested.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "AND",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {

     

       5
       5
       -
             "operator": "NOT",

     

       6
       6
       -
             "conditions": [

     

       7
       7
       -
               {

     

       8
       8
       -
                 "operator": "OR",

     

       9
       9
       -
                 "conditions": [

     

       10
       10
       -
                   {"hasKeyword": "$junk"},

     

       11
       11
       -
                   {"hasKeyword": "$spam"}

     

       12
       12
       -
                 ]

     

       13
       13
       -
               }

     

       14
       14
       -
             ]

     

       15
       15
       -
           },

     

       16
       16
       -
           {"inMailbox": "inbox"}

     

       17
       17
       -
         ]

     

       18
       18
       -
       }

-19

test/proto/filter/valid/nested.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "AND",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {"inMailbox": "inbox"},

     

       5
       5
       -
           {

     

       6
       6
       -
             "operator": "OR",

     

       7
       7
       -
             "conditions": [

     

       8
       8
       -
               {"from": "boss@company.com"},

     

       9
       9
       -
               {"hasKeyword": "$important"}

     

       10
       10
       -
             ]

     

       11
       11
       -
           },

     

       12
       12
       -
           {

     

       13
       13
       -
             "operator": "NOT",

     

       14
       14
       -
             "conditions": [

     

       15
       15
       -
               {"hasKeyword": "$seen"}

     

       16
       16
       -
             ]

     

       17
       17
       -
           }

     

       18
       18
       -
         ]

     

       19
       19
       -
       }

-13

test/proto/filter/valid/nested_and_or.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "AND",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {

     

       5
       5
       -
             "operator": "OR",

     

       6
       6
       -
             "conditions": [

     

       7
       7
       -
               {"inMailbox": "mb1"},

     

       8
       8
       -
               {"inMailbox": "mb2"}

     

       9
       9
       -
             ]

     

       10
       10
       -
           },

     

       11
       11
       -
           {"hasAttachment": true}

     

       12
       12
       -
         ]

     

       13
       13
       -
       }

-6

test/proto/filter/valid/not_operator.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "NOT",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {"hasKeyword": "$draft"}

     

       5
       5
       -
         ]

     

       6
       6
       -
       }

-7

test/proto/filter/valid/or_operator.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "operator": "OR",

     

       3
       3
       -
         "conditions": [

     

       4
       4
       -
           {"from": "alice@example.com"},

     

       5
       5
       -
           {"from": "bob@example.com"}

     

       6
       6
       -
         ]

     

       7
       7
       -
       }

-3

test/proto/filter/valid/simple_condition.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "inMailbox": "inbox123"

     

       3
       3
       -
       }

-1

test/proto/id/edge/creation_ref.json

···

       1
       1
       -
       #newEmail1

-1

test/proto/id/edge/digits_only.json

-1

test/proto/id/edge/max_length_255.json

···

       1
       1
       -
       aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa

-1

test/proto/id/edge/nil_literal.json

-1

test/proto/id/edge/over_max_length_256.json

···

       1
       1
       -
       aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa

-1

test/proto/id/edge/starts_with_dash.json

-1

test/proto/id/edge/starts_with_digit.json

test/proto/id/invalid/empty.json

This is a binary file and will not be displayed.

-1

test/proto/id/invalid/not_string.json

-1

test/proto/id/invalid/null.json

-1

test/proto/id/invalid/with_slash.json

···

       1
       1
       -
       abc/def

-1

test/proto/id/invalid/with_space.json

···

       1
       1
       -
       hello world

-1

test/proto/id/invalid/with_special.json

···

       1
       1
       -
       abc@def

-1

test/proto/id/valid/alphanumeric.json

···

       1
       1
       -
       ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789

-1

test/proto/id/valid/base64_like.json

···

       1
       1
       -
       dXNlcl8xMjM0NTY3ODkw

-1

test/proto/id/valid/simple.json

-1

test/proto/id/valid/single_char.json

-1

test/proto/id/valid/uuid_style.json

···

       1
       1
       -
       550e8400-e29b-41d4-a716-446655440000

-1

test/proto/id/valid/with_hyphen.json

···

       1
       1
       -
       msg-2024-01-15-abcdef

-1

test/proto/id/valid/with_underscore.json

···

       1
       1
       -
       user_123_abc

-1

test/proto/int53/edge/over_max_safe.json

···

       1
       1
       -
       9007199254740992

-1

test/proto/int53/edge/under_min_safe.json

···

       1
       1
       -
       -9007199254740992

-1

test/proto/int53/invalid/float.json

-1

test/proto/int53/invalid/leading_zero.json

-1

test/proto/int53/invalid/null.json

-1

test/proto/int53/invalid/scientific.json

-1

test/proto/int53/invalid/string.json

-1

test/proto/int53/valid/max_safe.json

···

       1
       1
       -
       9007199254740991

-1

test/proto/int53/valid/min_safe.json

···

       1
       1
       -
       -9007199254740991

-1

test/proto/int53/valid/negative.json

-1

test/proto/int53/valid/positive.json

-1

test/proto/int53/valid/zero.json

-1

test/proto/invocation/invalid/not_array.json

···

       1
       1
       -
       {"method": "Email/get", "args": {}, "callId": "c1"}

-1

test/proto/invocation/invalid/wrong_length.json

···

       1
       1
       -
       ["Email/get", {"accountId": "acc1"}]

-1

test/proto/invocation/valid/get.json

···

       1
       1
       -
       ["Email/get", {"accountId": "acc1", "ids": ["e1", "e2"]}, "call-001"]

-1

test/proto/invocation/valid/query.json

···

       1
       1
       -
       ["Email/query", {"accountId": "acc1", "filter": {"inMailbox": "inbox"}, "sort": [{"property": "receivedAt", "isAscending": false}], "limit": 50}, "call-003"]

-1

test/proto/invocation/valid/set.json

···

       1
       1
       -
       ["Mailbox/set", {"accountId": "acc1", "create": {"temp1": {"name": "Drafts"}}}, "call-002"]

-11

test/proto/mail/email/edge/empty_keywords.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e5",

     

       3
       3
       -
         "blobId": "blob5",

     

       4
       4
       -
         "threadId": "t5",

     

       5
       5
       -
         "size": 256,

     

       6
       6
       -
         "receivedAt": "2024-01-19T12:00:00Z",

     

       7
       7
       -
         "mailboxIds": {"mb1": true},

     

       8
       8
       -
         "keywords": {},

     

       9
       9
       -
         "hasAttachment": false,

     

       10
       10
       -
         "preview": "New unread email"

     

       11
       11
       -
       }

-14

test/proto/mail/email/valid/draft_email.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e3",

     

       3
       3
       -
         "blobId": "blob3",

     

       4
       4
       -
         "threadId": "t3",

     

       5
       5
       -
         "size": 512,

     

       6
       6
       -
         "receivedAt": "2024-01-17T14:00:00Z",

     

       7
       7
       -
         "mailboxIds": {"drafts": true},

     

       8
       8
       -
         "keywords": {"$draft": true},

     

       9
       9
       -
         "from": [{"name": "Me", "email": "me@example.com"}],

     

       10
       10
       -
         "to": [{"name": "You", "email": "you@example.com"}],

     

       11
       11
       -
         "subject": "Draft: Meeting notes",

     

       12
       12
       -
         "hasAttachment": false,

     

       13
       13
       -
         "preview": "This is a draft email"

     

       14
       14
       -
       }

-30

test/proto/mail/email/valid/full.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e2",

     

       3
       3
       -
         "blobId": "blob2",

     

       4
       4
       -
         "threadId": "t2",

     

       5
       5
       -
         "mailboxIds": {"inbox": true, "important": true},

     

       6
       6
       -
         "keywords": {"$seen": true, "$flagged": true, "$answered": true},

     

       7
       7
       -
         "size": 5000,

     

       8
       8
       -
         "receivedAt": "2024-01-15T14:30:00Z",

     

       9
       9
       -
         "messageId": ["msg123@example.com"],

     

       10
       10
       -
         "inReplyTo": ["msg100@example.com"],

     

       11
       11
       -
         "references": ["msg100@example.com", "msg99@example.com"],

     

       12
       12
       -
         "sender": [{"name": "Alice Smith", "email": "alice@example.com"}],

     

       13
       13
       -
         "from": [{"name": "Alice Smith", "email": "alice@example.com"}],

     

       14
       14
       -
         "to": [{"name": "Bob Jones", "email": "bob@example.com"}],

     

       15
       15
       -
         "cc": [{"name": "Carol White", "email": "carol@example.com"}],

     

       16
       16
       -
         "bcc": [],

     

       17
       17
       -
         "replyTo": [{"email": "alice-reply@example.com"}],

     

       18
       18
       -
         "subject": "Re: Important meeting",

     

       19
       19
       -
         "sentAt": "2024-01-15T14:29:00Z",

     

       20
       20
       -
         "hasAttachment": true,

     

       21
       21
       -
         "preview": "Thanks for the update. I'll review the documents and get back to you by...",

     

       22
       22
       -
         "bodyValues": {

     

       23
       23
       -
           "1": {"value": "Thanks for the update.\n\nI'll review the documents.", "isEncodingProblem": false, "isTruncated": false}

     

       24
       24
       -
         },

     

       25
       25
       -
         "textBody": [{"partId": "1", "type": "text/plain"}],

     

       26
       26
       -
         "htmlBody": [],

     

       27
       27
       -
         "attachments": [

     

       28
       28
       -
           {"partId": "2", "blobId": "attach1", "type": "application/pdf", "name": "document.pdf", "size": 12345}

     

       29
       29
       -
         ]

     

       30
       30
       -
       }

-9

test/proto/mail/email/valid/minimal.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e1",

     

       3
       3
       -
         "blobId": "blob1",

     

       4
       4
       -
         "threadId": "t1",

     

       5
       5
       -
         "mailboxIds": {"inbox": true},

     

       6
       6
       -
         "keywords": {},

     

       7
       7
       -
         "size": 1024,

     

       8
       8
       -
         "receivedAt": "2024-01-15T10:30:00Z"

     

       9
       9
       -
       }

-15

test/proto/mail/email/valid/multiple_mailboxes.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e2",

     

       3
       3
       -
         "blobId": "blob2",

     

       4
       4
       -
         "threadId": "t2",

     

       5
       5
       -
         "size": 4096,

     

       6
       6
       -
         "receivedAt": "2024-01-16T08:00:00Z",

     

       7
       7
       -
         "mailboxIds": {

     

       8
       8
       -
           "inbox": true,

     

       9
       9
       -
           "important": true,

     

       10
       10
       -
           "work": true

     

       11
       11
       -
         },

     

       12
       12
       -
         "keywords": {"$seen": true},

     

       13
       13
       -
         "hasAttachment": false,

     

       14
       14
       -
         "preview": "Email in multiple mailboxes"

     

       15
       15
       -
       }

-18

test/proto/mail/email/valid/with_all_system_keywords.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e4",

     

       3
       3
       -
         "blobId": "blob4",

     

       4
       4
       -
         "threadId": "t4",

     

       5
       5
       -
         "size": 8192,

     

       6
       6
       -
         "receivedAt": "2024-01-18T09:00:00Z",

     

       7
       7
       -
         "mailboxIds": {"mb1": true},

     

       8
       8
       -
         "keywords": {

     

       9
       9
       -
           "$draft": true,

     

       10
       10
       -
           "$seen": true,

     

       11
       11
       -
           "$flagged": true,

     

       12
       12
       -
           "$answered": true,

     

       13
       13
       -
           "$forwarded": true,

     

       14
       14
       -
           "custom-keyword": true

     

       15
       15
       -
         },

     

       16
       16
       -
         "hasAttachment": false,

     

       17
       17
       -
         "preview": "Email with all system keywords"

     

       18
       18
       -
       }

-16

test/proto/mail/email/valid/with_headers.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e3",

     

       3
       3
       -
         "blobId": "blob3",

     

       4
       4
       -
         "threadId": "t3",

     

       5
       5
       -
         "mailboxIds": {"inbox": true},

     

       6
       6
       -
         "keywords": {},

     

       7
       7
       -
         "size": 2048,

     

       8
       8
       -
         "receivedAt": "2024-01-16T09:00:00Z",

     

       9
       9
       -
         "headers": [

     

       10
       10
       -
           {"name": "X-Priority", "value": "1"},

     

       11
       11
       -
           {"name": "X-Mailer", "value": "Test Client 1.0"},

     

       12
       12
       -
           {"name": "List-Unsubscribe", "value": "<mailto:unsubscribe@example.com>"}

     

       13
       13
       -
         ],

     

       14
       14
       -
         "header:X-Priority:asText": "1",

     

       15
       15
       -
         "header:X-Mailer:asText": "Test Client 1.0"

     

       16
       16
       -
       }

-15

test/proto/mail/email/valid/with_keywords.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e1",

     

       3
       3
       -
         "blobId": "blob1",

     

       4
       4
       -
         "threadId": "t1",

     

       5
       5
       -
         "size": 2048,

     

       6
       6
       -
         "receivedAt": "2024-01-15T10:30:00Z",

     

       7
       7
       -
         "mailboxIds": {"mb1": true},

     

       8
       8
       -
         "keywords": {

     

       9
       9
       -
           "$seen": true,

     

       10
       10
       -
           "$flagged": true,

     

       11
       11
       -
           "$answered": true

     

       12
       12
       -
         },

     

       13
       13
       -
         "hasAttachment": false,

     

       14
       14
       -
         "preview": "This is a flagged and answered email"

     

       15
       15
       -
       }

-15

test/proto/mail/email/valid/with_message_ids.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "e6",

     

       3
       3
       -
         "blobId": "blob6",

     

       4
       4
       -
         "threadId": "t6",

     

       5
       5
       -
         "size": 4096,

     

       6
       6
       -
         "receivedAt": "2024-01-20T16:00:00Z",

     

       7
       7
       -
         "mailboxIds": {"inbox": true},

     

       8
       8
       -
         "keywords": {"$seen": true},

     

       9
       9
       -
         "messageId": ["unique-123@example.com"],

     

       10
       10
       -
         "inReplyTo": ["parent-456@example.com"],

     

       11
       11
       -
         "references": ["root-001@example.com", "parent-456@example.com"],

     

       12
       12
       -
         "subject": "Re: Original thread",

     

       13
       13
       -
         "hasAttachment": false,

     

       14
       14
       -
         "preview": "Reply in thread"

     

       15
       15
       -
       }

-3

test/proto/mail/email_address/valid/email_only.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "email": "anonymous@example.com"

     

       3
       3
       -
       }

-4

test/proto/mail/email_address/valid/full.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "name": "John Doe",

     

       3
       3
       -
         "email": "john.doe@example.com"

     

       4
       4
       -
       }

-28

test/proto/mail/email_body/edge/deep_nesting.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "0",

     

       3
       3
       -
         "size": 20000,

     

       4
       4
       -
         "type": "multipart/mixed",

     

       5
       5
       -
         "subParts": [

     

       6
       6
       -
           {

     

       7
       7
       -
             "partId": "1",

     

       8
       8
       -
             "size": 15000,

     

       9
       9
       -
             "type": "multipart/mixed",

     

       10
       10
       -
             "subParts": [

     

       11
       11
       -
               {

     

       12
       12
       -
                 "partId": "1.1",

     

       13
       13
       -
                 "size": 10000,

     

       14
       14
       -
                 "type": "multipart/alternative",

     

       15
       15
       -
                 "subParts": [

     

       16
       16
       -
                   {

     

       17
       17
       -
                     "partId": "1.1.1",

     

       18
       18
       -
                     "blobId": "b1",

     

       19
       19
       -
                     "size": 500,

     

       20
       20
       -
                     "type": "text/plain",

     

       21
       21
       -
                     "charset": "utf-8"

     

       22
       22
       -
                   }

     

       23
       23
       -
                 ]

     

       24
       24
       -
               }

     

       25
       25
       -
             ]

     

       26
       26
       -
           }

     

       27
       27
       -
         ]

     

       28
       28
       -
       }

-21

test/proto/mail/email_body/valid/multipart.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "0",

     

       3
       3
       -
         "size": 5000,

     

       4
       4
       -
         "type": "multipart/alternative",

     

       5
       5
       -
         "subParts": [

     

       6
       6
       -
           {

     

       7
       7
       -
             "partId": "1",

     

       8
       8
       -
             "blobId": "b1",

     

       9
       9
       -
             "size": 200,

     

       10
       10
       -
             "type": "text/plain",

     

       11
       11
       -
             "charset": "utf-8"

     

       12
       12
       -
           },

     

       13
       13
       -
           {

     

       14
       14
       -
             "partId": "2",

     

       15
       15
       -
             "blobId": "b2",

     

       16
       16
       -
             "size": 4800,

     

       17
       17
       -
             "type": "text/html",

     

       18
       18
       -
             "charset": "utf-8"

     

       19
       19
       -
           }

     

       20
       20
       -
         ]

     

       21
       21
       -
       }

-36

test/proto/mail/email_body/valid/multipart_mixed.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "0",

     

       3
       3
       -
         "size": 10000,

     

       4
       4
       -
         "type": "multipart/mixed",

     

       5
       5
       -
         "subParts": [

     

       6
       6
       -
           {

     

       7
       7
       -
             "partId": "1",

     

       8
       8
       -
             "size": 5000,

     

       9
       9
       -
             "type": "multipart/alternative",

     

       10
       10
       -
             "subParts": [

     

       11
       11
       -
               {

     

       12
       12
       -
                 "partId": "1.1",

     

       13
       13
       -
                 "blobId": "b1",

     

       14
       14
       -
                 "size": 500,

     

       15
       15
       -
                 "type": "text/plain",

     

       16
       16
       -
                 "charset": "utf-8"

     

       17
       17
       -
               },

     

       18
       18
       -
               {

     

       19
       19
       -
                 "partId": "1.2",

     

       20
       20
       -
                 "blobId": "b2",

     

       21
       21
       -
                 "size": 4500,

     

       22
       22
       -
                 "type": "text/html",

     

       23
       23
       -
                 "charset": "utf-8"

     

       24
       24
       -
               }

     

       25
       25
       -
             ]

     

       26
       26
       -
           },

     

       27
       27
       -
           {

     

       28
       28
       -
             "partId": "2",

     

       29
       29
       -
             "blobId": "b3",

     

       30
       30
       -
             "size": 5000,

     

       31
       31
       -
             "type": "application/pdf",

     

       32
       32
       -
             "name": "document.pdf",

     

       33
       33
       -
             "disposition": "attachment"

     

       34
       34
       -
           }

     

       35
       35
       -
         ]

     

       36
       36
       -
       }

-9

test/proto/mail/email_body/valid/text_part.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "1",

     

       3
       3
       -
         "blobId": "blobpart1",

     

       4
       4
       -
         "size": 500,

     

       5
       5
       -
         "headers": [{"name": "Content-Type", "value": "text/plain; charset=utf-8"}],

     

       6
       6
       -
         "type": "text/plain",

     

       7
       7
       -
         "charset": "utf-8",

     

       8
       8
       -
         "language": ["en"]

     

       9
       9
       -
       }

-23

test/proto/mail/email_body/valid/with_inline_image.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "0",

     

       3
       3
       -
         "size": 50000,

     

       4
       4
       -
         "type": "multipart/related",

     

       5
       5
       -
         "subParts": [

     

       6
       6
       -
           {

     

       7
       7
       -
             "partId": "1",

     

       8
       8
       -
             "blobId": "b1",

     

       9
       9
       -
             "size": 2000,

     

       10
       10
       -
             "type": "text/html",

     

       11
       11
       -
             "charset": "utf-8"

     

       12
       12
       -
           },

     

       13
       13
       -
           {

     

       14
       14
       -
             "partId": "2",

     

       15
       15
       -
             "blobId": "b2",

     

       16
       16
       -
             "size": 48000,

     

       17
       17
       -
             "type": "image/png",

     

       18
       18
       -
             "name": "logo.png",

     

       19
       19
       -
             "disposition": "inline",

     

       20
       20
       -
             "cid": "logo@example.com"

     

       21
       21
       -
           }

     

       22
       22
       -
         ]

     

       23
       23
       -
       }

-9

test/proto/mail/email_body/valid/with_language.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "partId": "1",

     

       3
       3
       -
         "blobId": "b1",

     

       4
       4
       -
         "size": 1000,

     

       5
       5
       -
         "type": "text/plain",

     

       6
       6
       -
         "charset": "utf-8",

     

       7
       7
       -
         "language": ["en", "de"],

     

       8
       8
       -
         "location": "https://example.com/message.txt"

     

       9
       9
       -
       }

-9

test/proto/mail/identity/valid/simple.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "ident1",

     

       3
       3
       -
         "name": "Work Identity",

     

       4
       4
       -
         "email": "john.doe@company.com",

     

       5
       5
       -
         "replyTo": [{"email": "john.doe@company.com"}],

     

       6
       6
       -
         "textSignature": "-- \nJohn Doe\nSenior Engineer",

     

       7
       7
       -
         "htmlSignature": "<p>-- </p><p><b>John Doe</b><br/>Senior Engineer</p>",

     

       8
       8
       -
         "mayDelete": true

     

       9
       9
       -
       }

-21

test/proto/mail/mailbox/edge/all_rights_false.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "mbReadOnly",

     

       3
       3
       -
         "name": "Read Only Folder",

     

       4
       4
       -
         "sortOrder": 99,

     

       5
       5
       -
         "totalEmails": 50,

     

       6
       6
       -
         "unreadEmails": 10,

     

       7
       7
       -
         "totalThreads": 40,

     

       8
       8
       -
         "unreadThreads": 8,

     

       9
       9
       -
         "myRights": {

     

       10
       10
       -
           "mayReadItems": true,

     

       11
       11
       -
           "mayAddItems": false,

     

       12
       12
       -
           "mayRemoveItems": false,

     

       13
       13
       -
           "maySetSeen": false,

     

       14
       14
       -
           "maySetKeywords": false,

     

       15
       15
       -
           "mayCreateChild": false,

     

       16
       16
       -
           "mayRename": false,

     

       17
       17
       -
           "mayDelete": false,

     

       18
       18
       -
           "maySubmit": false

     

       19
       19
       -
         },

     

       20
       20
       -
         "isSubscribed": false

     

       21
       21
       -
       }

-12

test/proto/mail/mailbox/valid/all_roles.json

···

       1
       1
       -
       [

     

       2
       2
       -
         {"id": "r1", "name": "Inbox", "role": "inbox", "sortOrder": 1},

     

       3
       3
       -
         {"id": "r2", "name": "Drafts", "role": "drafts", "sortOrder": 2},

     

       4
       4
       -
         {"id": "r3", "name": "Sent", "role": "sent", "sortOrder": 3},

     

       5
       5
       -
         {"id": "r4", "name": "Junk", "role": "junk", "sortOrder": 4},

     

       6
       6
       -
         {"id": "r5", "name": "Trash", "role": "trash", "sortOrder": 5},

     

       7
       7
       -
         {"id": "r6", "name": "Archive", "role": "archive", "sortOrder": 6},

     

       8
       8
       -
         {"id": "r7", "name": "All", "role": "all", "sortOrder": 7},

     

       9
       9
       -
         {"id": "r8", "name": "Important", "role": "important", "sortOrder": 8},

     

       10
       10
       -
         {"id": "r9", "name": "Scheduled", "role": "scheduled", "sortOrder": 9},

     

       11
       11
       -
         {"id": "r10", "name": "Subscribed", "role": "subscribed", "sortOrder": 10}

     

       12
       12
       -
       ]

-22

test/proto/mail/mailbox/valid/nested.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "mb2",

     

       3
       3
       -
         "name": "Work",

     

       4
       4
       -
         "parentId": "mb1",

     

       5
       5
       -
         "sortOrder": 10,

     

       6
       6
       -
         "totalEmails": 0,

     

       7
       7
       -
         "unreadEmails": 0,

     

       8
       8
       -
         "totalThreads": 0,

     

       9
       9
       -
         "unreadThreads": 0,

     

       10
       10
       -
         "myRights": {

     

       11
       11
       -
           "mayReadItems": true,

     

       12
       12
       -
           "mayAddItems": true,

     

       13
       13
       -
           "mayRemoveItems": true,

     

       14
       14
       -
           "maySetSeen": true,

     

       15
       15
       -
           "maySetKeywords": true,

     

       16
       16
       -
           "mayCreateChild": true,

     

       17
       17
       -
           "mayRename": true,

     

       18
       18
       -
           "mayDelete": true,

     

       19
       19
       -
           "maySubmit": false

     

       20
       20
       -
         },

     

       21
       21
       -
         "isSubscribed": false

     

       22
       22
       -
       }

-22

test/proto/mail/mailbox/valid/simple.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "mb1",

     

       3
       3
       -
         "name": "Inbox",

     

       4
       4
       -
         "role": "inbox",

     

       5
       5
       -
         "sortOrder": 1,

     

       6
       6
       -
         "totalEmails": 150,

     

       7
       7
       -
         "unreadEmails": 5,

     

       8
       8
       -
         "totalThreads": 100,

     

       9
       9
       -
         "unreadThreads": 3,

     

       10
       10
       -
         "myRights": {

     

       11
       11
       -
           "mayReadItems": true,

     

       12
       12
       -
           "mayAddItems": true,

     

       13
       13
       -
           "mayRemoveItems": true,

     

       14
       14
       -
           "maySetSeen": true,

     

       15
       15
       -
           "maySetKeywords": true,

     

       16
       16
       -
           "mayCreateChild": true,

     

       17
       17
       -
           "mayRename": false,

     

       18
       18
       -
           "mayDelete": false,

     

       19
       19
       -
           "maySubmit": true

     

       20
       20
       -
         },

     

       21
       21
       -
         "isSubscribed": true

     

       22
       22
       -
       }

-22

test/proto/mail/mailbox/valid/with_all_roles.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "mbArchive",

     

       3
       3
       -
         "name": "Archive",

     

       4
       4
       -
         "role": "archive",

     

       5
       5
       -
         "sortOrder": 5,

     

       6
       6
       -
         "totalEmails": 1000,

     

       7
       7
       -
         "unreadEmails": 0,

     

       8
       8
       -
         "totalThreads": 800,

     

       9
       9
       -
         "unreadThreads": 0,

     

       10
       10
       -
         "myRights": {

     

       11
       11
       -
           "mayReadItems": true,

     

       12
       12
       -
           "mayAddItems": true,

     

       13
       13
       -
           "mayRemoveItems": true,

     

       14
       14
       -
           "maySetSeen": true,

     

       15
       15
       -
           "maySetKeywords": true,

     

       16
       16
       -
           "mayCreateChild": true,

     

       17
       17
       -
           "mayRename": true,

     

       18
       18
       -
           "mayDelete": true,

     

       19
       19
       -
           "maySubmit": false

     

       20
       20
       -
         },

     

       21
       21
       -
         "isSubscribed": true

     

       22
       22
       -
       }

-21

test/proto/mail/submission/valid/final_status.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "sub3",

     

       3
       3
       -
         "identityId": "ident1",

     

       4
       4
       -
         "emailId": "e2",

     

       5
       5
       -
         "threadId": "t2",

     

       6
       6
       -
         "envelope": {

     

       7
       7
       -
           "mailFrom": {"email": "sender@example.com"},

     

       8
       8
       -
           "rcptTo": [{"email": "recipient@example.com"}]

     

       9
       9
       -
         },

     

       10
       10
       -
         "sendAt": "2024-01-15T12:00:00Z",

     

       11
       11
       -
         "undoStatus": "final",

     

       12
       12
       -
         "deliveryStatus": {

     

       13
       13
       -
           "recipient@example.com": {

     

       14
       14
       -
             "smtpReply": "250 2.0.0 OK",

     

       15
       15
       -
             "delivered": "yes",

     

       16
       16
       -
             "displayed": "unknown"

     

       17
       17
       -
           }

     

       18
       18
       -
         },

     

       19
       19
       -
         "dsnBlobIds": [],

     

       20
       20
       -
         "mdnBlobIds": []

     

       21
       21
       -
       }

-14

test/proto/mail/submission/valid/simple.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "sub1",

     

       3
       3
       -
         "identityId": "ident1",

     

       4
       4
       -
         "emailId": "e1",

     

       5
       5
       -
         "threadId": "t1",

     

       6
       6
       -
         "envelope": {

     

       7
       7
       -
           "mailFrom": {"email": "sender@example.com"},

     

       8
       8
       -
           "rcptTo": [{"email": "recipient@example.com"}]

     

       9
       9
       -
         },

     

       10
       10
       -
         "sendAt": "2024-01-15T15:00:00Z",

     

       11
       11
       -
         "undoStatus": "pending",

     

       12
       12
       -
         "dsnBlobIds": [],

     

       13
       13
       -
         "mdnBlobIds": []

     

       14
       14
       -
       }

-20

test/proto/mail/submission/valid/with_envelope.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "sub2",

     

       3
       3
       -
         "identityId": "ident1",

     

       4
       4
       -
         "emailId": "e1",

     

       5
       5
       -
         "threadId": "t1",

     

       6
       6
       -
         "envelope": {

     

       7
       7
       -
           "mailFrom": {

     

       8
       8
       -
             "email": "sender@example.com",

     

       9
       9
       -
             "parameters": {"SIZE": "1024", "BODY": "8BITMIME"}

     

       10
       10
       -
           },

     

       11
       11
       -
           "rcptTo": [

     

       12
       12
       -
             {"email": "recipient1@example.com"},

     

       13
       13
       -
             {"email": "recipient2@example.com", "parameters": {"NOTIFY": "SUCCESS,FAILURE"}}

     

       14
       14
       -
           ]

     

       15
       15
       -
         },

     

       16
       16
       -
         "sendAt": "2024-01-15T15:00:00Z",

     

       17
       17
       -
         "undoStatus": "pending",

     

       18
       18
       -
         "dsnBlobIds": [],

     

       19
       19
       -
         "mdnBlobIds": []

     

       20
       20
       -
       }

-4

test/proto/mail/thread/valid/conversation.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "t2",

     

       3
       3
       -
         "emailIds": ["e10", "e11", "e12", "e13", "e14"]

     

       4
       4
       -
       }

-4

test/proto/mail/thread/valid/simple.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "t1",

     

       3
       3
       -
         "emailIds": ["e1"]

     

       4
       4
       -
       }

-4

test/proto/mail/vacation/valid/disabled.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "singleton",

     

       3
       3
       -
         "isEnabled": false

     

       4
       4
       -
       }

-9

test/proto/mail/vacation/valid/enabled.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "id": "singleton",

     

       3
       3
       -
         "isEnabled": true,

     

       4
       4
       -
         "fromDate": "2024-01-20T00:00:00Z",

     

       5
       5
       -
         "toDate": "2024-01-27T23:59:59Z",

     

       6
       6
       -
         "subject": "Out of Office",

     

       7
       7
       -
         "textBody": "I am currently out of the office and will return on January 27th.",

     

       8
       8
       -
         "htmlBody": "<p>I am currently out of the office and will return on January 27th.</p>"

     

       9
       9
       -
       }

-9

test/proto/method/valid/changes_response.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "oldState": "old123",

     

       4
       4
       -
         "newState": "new456",

     

       5
       5
       -
         "hasMoreChanges": false,

     

       6
       6
       -
         "created": ["id1", "id2"],

     

       7
       7
       -
         "updated": ["id3"],

     

       8
       8
       -
         "destroyed": ["id4", "id5"]

     

       9
       9
       -
       }

-5

test/proto/method/valid/get_args.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "ids": ["id1", "id2", "id3"],

     

       4
       4
       -
         "properties": ["id", "name", "role"]

     

       5
       5
       -
       }

-3

test/proto/method/valid/get_args_minimal.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1"

     

       3
       3
       -
       }

-16

test/proto/method/valid/query_args.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "filter": {

     

       4
       4
       -
           "operator": "AND",

     

       5
       5
       -
           "conditions": [

     

       6
       6
       -
             {"inMailbox": "inbox"},

     

       7
       7
       -
             {"hasKeyword": "$seen"}

     

       8
       8
       -
           ]

     

       9
       9
       -
         },

     

       10
       10
       -
         "sort": [

     

       11
       11
       -
           {"property": "receivedAt", "isAscending": false}

     

       12
       12
       -
         ],

     

       13
       13
       -
         "position": 0,

     

       14
       14
       -
         "limit": 100,

     

       15
       15
       -
         "calculateTotal": true

     

       16
       16
       -
       }

-8

test/proto/method/valid/query_response.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "queryState": "qs1",

     

       4
       4
       -
         "canCalculateChanges": true,

     

       5
       5
       -
         "position": 0,

     

       6
       6
       -
         "ids": ["e1", "e2", "e3", "e4", "e5"],

     

       7
       7
       -
         "total": 250

     

       8
       8
       -
       }

-12

test/proto/method/valid/set_args.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "ifInState": "state123",

     

       4
       4
       -
         "create": {

     

       5
       5
       -
           "new1": {"name": "Folder 1"},

     

       6
       6
       -
           "new2": {"name": "Folder 2"}

     

       7
       7
       -
         },

     

       8
       8
       -
         "update": {

     

       9
       9
       -
           "existing1": {"name": "Renamed Folder"}

     

       10
       10
       -
         },

     

       11
       11
       -
         "destroy": ["old1", "old2"]

     

       12
       12
       -
       }

-16

test/proto/method/valid/set_response.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "oldState": "state123",

     

       4
       4
       -
         "newState": "state456",

     

       5
       5
       -
         "created": {

     

       6
       6
       -
           "new1": {"id": "mb123", "name": "Folder 1"},

     

       7
       7
       -
           "new2": {"id": "mb456", "name": "Folder 2"}

     

       8
       8
       -
         },

     

       9
       9
       -
         "updated": {

     

       10
       10
       -
           "existing1": null

     

       11
       11
       -
         },

     

       12
       12
       -
         "destroyed": ["old1", "old2"],

     

       13
       13
       -
         "notCreated": {},

     

       14
       14
       -
         "notUpdated": {},

     

       15
       15
       -
         "notDestroyed": {}

     

       16
       16
       -
       }

-19

test/proto/method/valid/set_response_with_errors.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accountId": "acc1",

     

       3
       3
       -
         "oldState": "state123",

     

       4
       4
       -
         "newState": "state124",

     

       5
       5
       -
         "created": {

     

       6
       6
       -
           "new1": {"id": "mb789", "name": "Success Folder"}

     

       7
       7
       -
         },

     

       8
       8
       -
         "updated": {},

     

       9
       9
       -
         "destroyed": [],

     

       10
       10
       -
         "notCreated": {

     

       11
       11
       -
           "new2": {"type": "invalidProperties", "properties": ["name"]}

     

       12
       12
       -
         },

     

       13
       13
       -
         "notUpdated": {

     

       14
       14
       -
           "existing1": {"type": "notFound"}

     

       15
       15
       -
         },

     

       16
       16
       -
         "notDestroyed": {

     

       17
       17
       -
           "old1": {"type": "forbidden", "description": "Cannot delete inbox"}

     

       18
       18
       -
         }

     

       19
       19
       -
       }

-5

test/proto/request/invalid/missing_using.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodCalls": [

     

       3
       3
       -
           ["Mailbox/get", {"accountId": "acc1"}, "c1"]

     

       4
       4
       -
         ]

     

       5
       5
       -
       }

-1

test/proto/request/invalid/not_object.json

···

       1
       1
       -
       ["urn:ietf:params:jmap:core"]

-4

test/proto/request/valid/empty_methods.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core"],

     

       3
       3
       -
         "methodCalls": []

     

       4
       4
       -
       }

-8

test/proto/request/valid/multiple_methods.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],

     

       3
       3
       -
         "methodCalls": [

     

       4
       4
       -
           ["Mailbox/get", {"accountId": "acc1"}, "c1"],

     

       5
       5
       -
           ["Email/query", {"accountId": "acc1", "filter": {"inMailbox": "inbox1"}}, "c2"],

     

       6
       6
       -
           ["Email/get", {"accountId": "acc1", "#ids": {"resultOf": "c2", "name": "Email/query", "path": "/ids"}}, "c3"]

     

       7
       7
       -
         ]

     

       8
       8
       -
       }

-6

test/proto/request/valid/single_method.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],

     

       3
       3
       -
         "methodCalls": [

     

       4
       4
       -
           ["Mailbox/get", {"accountId": "acc1"}, "c1"]

     

       5
       5
       -
         ]

     

       6
       6
       -
       }

-9

test/proto/request/valid/with_created_ids.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],

     

       3
       3
       -
         "methodCalls": [

     

       4
       4
       -
           ["Mailbox/set", {"accountId": "acc1", "create": {"temp1": {"name": "New Folder", "parentId": null}}}, "c1"]

     

       5
       5
       -
         ],

     

       6
       6
       -
         "createdIds": {

     

       7
       7
       -
           "temp1": "server-assigned-id-1"

     

       8
       8
       -
         }

     

       9
       9
       -
       }

-20

test/proto/request/valid/with_creation_refs.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],

     

       3
       3
       -
         "methodCalls": [

     

       4
       4
       -
           ["Mailbox/set", {

     

       5
       5
       -
             "accountId": "acc1",

     

       6
       6
       -
             "create": {

     

       7
       7
       -
               "newBox": {"name": "New Folder", "parentId": null}

     

       8
       8
       -
             }

     

       9
       9
       -
           }, "c1"],

     

       10
       10
       -
           ["Email/set", {

     

       11
       11
       -
             "accountId": "acc1",

     

       12
       12
       -
             "create": {

     

       13
       13
       -
               "draft1": {

     

       14
       14
       -
                 "mailboxIds": {"#newBox": true},

     

       15
       15
       -
                 "subject": "Draft in new folder"

     

       16
       16
       -
               }

     

       17
       17
       -
             }

     

       18
       18
       -
           }, "c2"]

     

       19
       19
       -
         ]

     

       20
       20
       -
       }

-7

test/proto/request/valid/with_result_reference.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],

     

       3
       3
       -
         "methodCalls": [

     

       4
       4
       -
           ["Mailbox/query", {"accountId": "acc1", "filter": {"role": "inbox"}}, "0"],

     

       5
       5
       -
           ["Mailbox/get", {"accountId": "acc1", "#ids": {"resultOf": "0", "name": "Mailbox/query", "path": "/ids"}}, "1"]

     

       6
       6
       -
         ]

     

       7
       7
       -
       }

-5

test/proto/response/invalid/missing_session_state.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodResponses": [

     

       3
       3
       -
           ["Mailbox/get", {"accountId": "acc1", "state": "state1", "list": [], "notFound": []}, "c1"]

     

       4
       4
       -
         ]

     

       5
       5
       -
       }

-7

test/proto/response/valid/multiple_responses.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodResponses": [

     

       3
       3
       -
           ["Email/query", {"accountId": "acc1", "queryState": "q1", "canCalculateChanges": true, "position": 0, "ids": ["e1", "e2", "e3"], "total": 100}, "c1"],

     

       4
       4
       -
           ["Email/get", {"accountId": "acc1", "state": "s1", "list": [{"id": "e1", "blobId": "b1", "threadId": "t1", "mailboxIds": {"inbox": true}, "keywords": {"$seen": true}, "size": 1234, "receivedAt": "2024-01-15T10:30:00Z"}], "notFound": []}, "c2"]

     

       5
       5
       -
         ],

     

       6
       6
       -
         "sessionState": "sessionABC"

     

       7
       7
       -
       }

-6

test/proto/response/valid/success.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodResponses": [

     

       3
       3
       -
           ["Mailbox/get", {"accountId": "acc1", "state": "state1", "list": [], "notFound": []}, "c1"]

     

       4
       4
       -
         ],

     

       5
       5
       -
         "sessionState": "session123"

     

       6
       6
       -
       }

-9

test/proto/response/valid/with_created_ids.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodResponses": [

     

       3
       3
       -
           ["Mailbox/set", {"accountId": "acc1", "oldState": "state1", "newState": "state2", "created": {"temp1": {"id": "real1"}}}, "c1"]

     

       4
       4
       -
         ],

     

       5
       5
       -
         "createdIds": {

     

       6
       6
       -
           "temp1": "real1"

     

       7
       7
       -
         },

     

       8
       8
       -
         "sessionState": "session456"

     

       9
       9
       -
       }

-6

test/proto/response/valid/with_error.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "methodResponses": [

     

       3
       3
       -
           ["error", {"type": "unknownMethod"}, "c1"]

     

       4
       4
       -
         ],

     

       5
       5
       -
         "sessionState": "session789"

     

       6
       6
       -
       }

-22

test/proto/session/edge/empty_accounts.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "capabilities": {

     

       3
       3
       -
           "urn:ietf:params:jmap:core": {

     

       4
       4
       -
             "maxSizeUpload": 50000000,

     

       5
       5
       -
             "maxConcurrentUpload": 4,

     

       6
       6
       -
             "maxSizeRequest": 10000000,

     

       7
       7
       -
             "maxConcurrentRequests": 4,

     

       8
       8
       -
             "maxCallsInRequest": 16,

     

       9
       9
       -
             "maxObjectsInGet": 500,

     

       10
       10
       -
             "maxObjectsInSet": 500,

     

       11
       11
       -
             "collationAlgorithms": []

     

       12
       12
       -
           }

     

       13
       13
       -
         },

     

       14
       14
       -
         "accounts": {},

     

       15
       15
       -
         "primaryAccounts": {},

     

       16
       16
       -
         "username": "anonymous",

     

       17
       17
       -
         "apiUrl": "https://api.example.com/jmap/",

     

       18
       18
       -
         "downloadUrl": "https://api.example.com/download/{accountId}/{blobId}/{name}",

     

       19
       19
       -
         "uploadUrl": "https://api.example.com/upload/{accountId}/",

     

       20
       20
       -
         "eventSourceUrl": "https://api.example.com/events/",

     

       21
       21
       -
         "state": "empty"

     

       22
       22
       -
       }

-10

test/proto/session/invalid/missing_api_url.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "capabilities": {},

     

       3
       3
       -
         "accounts": {},

     

       4
       4
       -
         "primaryAccounts": {},

     

       5
       5
       -
         "username": "test@example.com",

     

       6
       6
       -
         "downloadUrl": "https://api.example.com/download/",

     

       7
       7
       -
         "uploadUrl": "https://api.example.com/upload/",

     

       8
       8
       -
         "eventSourceUrl": "https://api.example.com/events/",

     

       9
       9
       -
         "state": "abc"

     

       10
       10
       -
       }

-17

test/proto/session/invalid/missing_capabilities.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "accounts": {

     

       3
       3
       -
           "acc1": {

     

       4
       4
       -
             "name": "Test Account",

     

       5
       5
       -
             "isPersonal": true,

     

       6
       6
       -
             "isReadOnly": false,

     

       7
       7
       -
             "accountCapabilities": {}

     

       8
       8
       -
           }

     

       9
       9
       -
         },

     

       10
       10
       -
         "primaryAccounts": {},

     

       11
       11
       -
         "username": "test@example.com",

     

       12
       12
       -
         "apiUrl": "https://api.example.com/jmap/",

     

       13
       13
       -
         "downloadUrl": "https://api.example.com/download/",

     

       14
       14
       -
         "uploadUrl": "https://api.example.com/upload/",

     

       15
       15
       -
         "eventSourceUrl": "https://api.example.com/events/",

     

       16
       16
       -
         "state": "abc"

     

       17
       17
       -
       }

-31

test/proto/session/valid/minimal.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "capabilities": {

     

       3
       3
       -
           "urn:ietf:params:jmap:core": {

     

       4
       4
       -
             "maxSizeUpload": 50000000,

     

       5
       5
       -
             "maxConcurrentUpload": 4,

     

       6
       6
       -
             "maxSizeRequest": 10000000,

     

       7
       7
       -
             "maxConcurrentRequests": 4,

     

       8
       8
       -
             "maxCallsInRequest": 16,

     

       9
       9
       -
             "maxObjectsInGet": 500,

     

       10
       10
       -
             "maxObjectsInSet": 500,

     

       11
       11
       -
             "collationAlgorithms": ["i;ascii-casemap", "i;octet"]

     

       12
       12
       -
           }

     

       13
       13
       -
         },

     

       14
       14
       -
         "accounts": {

     

       15
       15
       -
           "acc1": {

     

       16
       16
       -
             "name": "Test Account",

     

       17
       17
       -
             "isPersonal": true,

     

       18
       18
       -
             "isReadOnly": false,

     

       19
       19
       -
             "accountCapabilities": {}

     

       20
       20
       -
           }

     

       21
       21
       -
         },

     

       22
       22
       -
         "primaryAccounts": {

     

       23
       23
       -
           "urn:ietf:params:jmap:core": "acc1"

     

       24
       24
       -
         },

     

       25
       25
       -
         "username": "test@example.com",

     

       26
       26
       -
         "apiUrl": "https://api.example.com/jmap/",

     

       27
       27
       -
         "downloadUrl": "https://api.example.com/jmap/download/{accountId}/{blobId}/{name}?type={type}",

     

       28
       28
       -
         "uploadUrl": "https://api.example.com/jmap/upload/{accountId}/",

     

       29
       29
       -
         "eventSourceUrl": "https://api.example.com/jmap/eventsource/",

     

       30
       30
       -
         "state": "abc123"

     

       31
       31
       -
       }

-44

test/proto/session/valid/with_accounts.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "capabilities": {

     

       3
       3
       -
           "urn:ietf:params:jmap:core": {

     

       4
       4
       -
             "maxSizeUpload": 50000000,

     

       5
       5
       -
             "maxConcurrentUpload": 4,

     

       6
       6
       -
             "maxSizeRequest": 10000000,

     

       7
       7
       -
             "maxConcurrentRequests": 4,

     

       8
       8
       -
             "maxCallsInRequest": 16,

     

       9
       9
       -
             "maxObjectsInGet": 500,

     

       10
       10
       -
             "maxObjectsInSet": 500,

     

       11
       11
       -
             "collationAlgorithms": ["i;ascii-casemap", "i;unicode-casemap"]

     

       12
       12
       -
           }

     

       13
       13
       -
         },

     

       14
       14
       -
         "accounts": {

     

       15
       15
       -
           "acc1": {

     

       16
       16
       -
             "name": "Personal Account",

     

       17
       17
       -
             "isPersonal": true,

     

       18
       18
       -
             "isReadOnly": false,

     

       19
       19
       -
             "accountCapabilities": {

     

       20
       20
       -
               "urn:ietf:params:jmap:core": {},

     

       21
       21
       -
               "urn:ietf:params:jmap:mail": {}

     

       22
       22
       -
             }

     

       23
       23
       -
           },

     

       24
       24
       -
           "acc2": {

     

       25
       25
       -
             "name": "Shared Account",

     

       26
       26
       -
             "isPersonal": false,

     

       27
       27
       -
             "isReadOnly": true,

     

       28
       28
       -
             "accountCapabilities": {

     

       29
       29
       -
               "urn:ietf:params:jmap:core": {},

     

       30
       30
       -
               "urn:ietf:params:jmap:mail": {}

     

       31
       31
       -
             }

     

       32
       32
       -
           }

     

       33
       33
       -
         },

     

       34
       34
       -
         "primaryAccounts": {

     

       35
       35
       -
           "urn:ietf:params:jmap:core": "acc1",

     

       36
       36
       -
           "urn:ietf:params:jmap:mail": "acc1"

     

       37
       37
       -
         },

     

       38
       38
       -
         "username": "user@example.com",

     

       39
       39
       -
         "apiUrl": "https://api.example.com/jmap/",

     

       40
       40
       -
         "downloadUrl": "https://api.example.com/download/{accountId}/{blobId}/{name}?accept={type}",

     

       41
       41
       -
         "uploadUrl": "https://api.example.com/upload/{accountId}/",

     

       42
       42
       -
         "eventSourceUrl": "https://api.example.com/eventsource/?types={types}&closeafter={closeafter}&ping={ping}",

     

       43
       43
       -
         "state": "session123"

     

       44
       44
       -
       }

-56

test/proto/session/valid/with_mail.json

···

       1
       1
       -
       {

     

       2
       2
       -
         "capabilities": {

     

       3
       3
       -
           "urn:ietf:params:jmap:core": {

     

       4
       4
       -
             "maxSizeUpload": 50000000,

     

       5
       5
       -
             "maxConcurrentUpload": 4,

     

       6
       6
       -
             "maxSizeRequest": 10000000,

     

       7
       7
       -
             "maxConcurrentRequests": 4,

     

       8
       8
       -
             "maxCallsInRequest": 16,

     

       9
       9
       -
             "maxObjectsInGet": 500,

     

       10
       10
       -
             "maxObjectsInSet": 500,

     

       11
       11
       -
             "collationAlgorithms": ["i;ascii-casemap", "i;octet"]

     

       12
       12
       -
           },

     

       13
       13
       -
           "urn:ietf:params:jmap:mail": {

     

       14
       14
       -
             "maxMailboxesPerEmail": 1000,

     

       15
       15
       -
             "maxMailboxDepth": 10,

     

       16
       16
       -
             "maxSizeMailboxName": 490,

     

       17
       17
       -
             "maxSizeAttachmentsPerEmail": 50000000,

     

       18
       18
       -
             "emailQuerySortOptions": ["receivedAt", "from", "to", "subject", "size"],

     

       19
       19
       -
             "mayCreateTopLevelMailbox": true

     

       20
       20
       -
           },

     

       21
       21
       -
           "urn:ietf:params:jmap:submission": {

     

       22
       22
       -
             "maxDelayedSend": 86400,

     

       23
       23
       -
             "submissionExtensions": {}

     

       24
       24
       -
           }

     

       25
       25
       -
         },

     

       26
       26
       -
         "accounts": {

     

       27
       27
       -
           "A001": {

     

       28
       28
       -
             "name": "Personal",

     

       29
       29
       -
             "isPersonal": true,

     

       30
       30
       -
             "isReadOnly": false,

     

       31
       31
       -
             "accountCapabilities": {

     

       32
       32
       -
               "urn:ietf:params:jmap:core": {},

     

       33
       33
       -
               "urn:ietf:params:jmap:mail": {}

     

       34
       34
       -
             }

     

       35
       35
       -
           },

     

       36
       36
       -
           "A002": {

     

       37
       37
       -
             "name": "Shared Archive",

     

       38
       38
       -
             "isPersonal": false,

     

       39
       39
       -
             "isReadOnly": true,

     

       40
       40
       -
             "accountCapabilities": {

     

       41
       41
       -
               "urn:ietf:params:jmap:mail": {}

     

       42
       42
       -
             }

     

       43
       43
       -
           }

     

       44
       44
       -
         },

     

       45
       45
       -
         "primaryAccounts": {

     

       46
       46
       -
           "urn:ietf:params:jmap:core": "A001",

     

       47
       47
       -
           "urn:ietf:params:jmap:mail": "A001",

     

       48
       48
       -
           "urn:ietf:params:jmap:submission": "A001"

     

       49
       49
       -
         },

     

       50
       50
       -
         "username": "john.doe@example.com",

     

       51
       51
       -
         "apiUrl": "https://jmap.example.com/api/",

     

       52
       52
       -
         "downloadUrl": "https://jmap.example.com/download/{accountId}/{blobId}/{name}?type={type}",

     

       53
       53
       -
         "uploadUrl": "https://jmap.example.com/upload/{accountId}/",

     

       54
       54
       -
         "eventSourceUrl": "https://jmap.example.com/events/?types={types}&closeafter={closeafter}&ping={ping}",

     

       55
       55
       -
         "state": "xyz789-session-state"

     

       56
       56
       -
       }

-987

test/proto/test_proto.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
          Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.

     

       3
       3
       -
          SPDX-License-Identifier: ISC

     

       4
       4
       -
         ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** JMAP Protocol codec tests using sample JSON files *)

     

       7
       7
       -
       

     

       8
       8
       -
       let read_file path =

     

       9
       9
       -
         let ic = open_in path in

     

       10
       10
       -
         let n = in_channel_length ic in

     

       11
       11
       -
         let s = really_input_string ic n in

     

       12
       12
       -
         close_in ic;

     

       13
       13
       -
         s

     

       14
       14
       -
       

     

       15
       15
       -
       let decode jsont json_str =

     

       16
       16
       -
         Jsont_bytesrw.decode_string' jsont json_str

     

       17
       17
       -
       

     

       18
       18
       -
       let encode jsont value =

     

       19
       19
       -
         Jsont_bytesrw.encode_string' jsont value

     

       20
       20
       -
       

     

       21
       21
       -
       (* Test helpers *)

     

       22
       22
       -
       

     

       23
       23
       -
       let test_decode_success name jsont path () =

     

       24
       24
       -
         let json = read_file path in

     

       25
       25
       -
         match decode jsont json with

     

       26
       26
       -
         | Ok _ -> ()

     

       27
       27
       -
         | Error e ->

     

       28
       28
       -
             Alcotest.failf "%s: expected success but got error: %s" name (Jsont.Error.to_string e)

     

       29
       29
       -
       

     

       30
       30
       -
       let test_decode_failure name jsont path () =

     

       31
       31
       -
         let json = read_file path in

     

       32
       32
       -
         match decode jsont json with

     

       33
       33
       -
         | Ok _ -> Alcotest.failf "%s: expected failure but got success" name

     

       34
       34
       -
         | Error _ -> ()

     

       35
       35
       -
       

     

       36
       36
       -
       let test_roundtrip name jsont path () =

     

       37
       37
       -
         let json = read_file path in

     

       38
       38
       -
         match decode jsont json with

     

       39
       39
       -
         | Error e ->

     

       40
       40
       -
             Alcotest.failf "%s: decode failed: %s" name (Jsont.Error.to_string e)

     

       41
       41
       -
         | Ok value ->

     

       42
       42
       -
             match encode jsont value with

     

       43
       43
       -
             | Error e ->

     

       44
       44
       -
                 Alcotest.failf "%s: encode failed: %s" name (Jsont.Error.to_string e)

     

       45
       45
       -
             | Ok encoded ->

     

       46
       46
       -
                 match decode jsont encoded with

     

       47
       47
       -
                 | Error e ->

     

       48
       48
       -
                     Alcotest.failf "%s: re-decode failed: %s" name (Jsont.Error.to_string e)

     

       49
       49
       -
                 | Ok _ -> ()

     

       50
       50
       -
       

     

       51
       51
       -
       (* ID tests *)

     

       52
       52
       -
       module Id_tests = struct

     

       53
       53
       -
         open Jmap_proto

     

       54
       54
       -
       

     

       55
       55
       -
         let test_valid_simple () =

     

       56
       56
       -
           let json = "\"abc123\"" in

     

       57
       57
       -
           match decode Id.jsont json with

     

       58
       58
       -
           | Ok id -> Alcotest.(check string) "id value" "abc123" (Id.to_string id)

     

       59
       59
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       60
       60
       -
       

     

       61
       61
       -
         let test_valid_single_char () =

     

       62
       62
       -
           let json = "\"a\"" in

     

       63
       63
       -
           match decode Id.jsont json with

     

       64
       64
       -
           | Ok id -> Alcotest.(check string) "id value" "a" (Id.to_string id)

     

       65
       65
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       66
       66
       -
       

     

       67
       67
       -
         let test_valid_with_hyphen () =

     

       68
       68
       -
           let json = "\"msg-2024-01\"" in

     

       69
       69
       -
           match decode Id.jsont json with

     

       70
       70
       -
           | Ok id -> Alcotest.(check string) "id value" "msg-2024-01" (Id.to_string id)

     

       71
       71
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       72
       72
       -
       

     

       73
       73
       -
         let test_valid_with_underscore () =

     

       74
       74
       -
           let json = "\"user_id_123\"" in

     

       75
       75
       -
           match decode Id.jsont json with

     

       76
       76
       -
           | Ok id -> Alcotest.(check string) "id value" "user_id_123" (Id.to_string id)

     

       77
       77
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       78
       78
       -
       

     

       79
       79
       -
         let test_invalid_empty () =

     

       80
       80
       -
           let json = "\"\"" in

     

       81
       81
       -
           match decode Id.jsont json with

     

       82
       82
       -
           | Ok _ -> Alcotest.fail "expected failure for empty id"

     

       83
       83
       -
           | Error _ -> ()

     

       84
       84
       -
       

     

       85
       85
       -
         let test_invalid_with_space () =

     

       86
       86
       -
           let json = "\"hello world\"" in

     

       87
       87
       -
           match decode Id.jsont json with

     

       88
       88
       -
           | Ok _ -> Alcotest.fail "expected failure for id with space"

     

       89
       89
       -
           | Error _ -> ()

     

       90
       90
       -
       

     

       91
       91
       -
         let test_invalid_with_special () =

     

       92
       92
       -
           let json = "\"abc@def\"" in

     

       93
       93
       -
           match decode Id.jsont json with

     

       94
       94
       -
           | Ok _ -> Alcotest.fail "expected failure for id with @"

     

       95
       95
       -
           | Error _ -> ()

     

       96
       96
       -
       

     

       97
       97
       -
         let test_invalid_not_string () =

     

       98
       98
       -
           let json = "12345" in

     

       99
       99
       -
           match decode Id.jsont json with

     

       100
       100
       -
           | Ok _ -> Alcotest.fail "expected failure for non-string"

     

       101
       101
       -
           | Error _ -> ()

     

       102
       102
       -
       

     

       103
       103
       -
         let test_edge_max_length () =

     

       104
       104
       -
           let id_255 = String.make 255 'a' in

     

       105
       105
       -
           let json = Printf.sprintf "\"%s\"" id_255 in

     

       106
       106
       -
           match decode Id.jsont json with

     

       107
       107
       -
           | Ok id -> Alcotest.(check int) "id length" 255 (String.length (Id.to_string id))

     

       108
       108
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       109
       109
       -
       

     

       110
       110
       -
         let test_edge_over_max_length () =

     

       111
       111
       -
           let id_256 = String.make 256 'a' in

     

       112
       112
       -
           let json = Printf.sprintf "\"%s\"" id_256 in

     

       113
       113
       -
           match decode Id.jsont json with

     

       114
       114
       -
           | Ok _ -> Alcotest.fail "expected failure for 256 char id"

     

       115
       115
       -
           | Error _ -> ()

     

       116
       116
       -
       

     

       117
       117
       -
         let tests = [

     

       118
       118
       -
           "valid: simple", `Quick, test_valid_simple;

     

       119
       119
       -
           "valid: single char", `Quick, test_valid_single_char;

     

       120
       120
       -
           "valid: with hyphen", `Quick, test_valid_with_hyphen;

     

       121
       121
       -
           "valid: with underscore", `Quick, test_valid_with_underscore;

     

       122
       122
       -
           "invalid: empty", `Quick, test_invalid_empty;

     

       123
       123
       -
           "invalid: with space", `Quick, test_invalid_with_space;

     

       124
       124
       -
           "invalid: with special", `Quick, test_invalid_with_special;

     

       125
       125
       -
           "invalid: not string", `Quick, test_invalid_not_string;

     

       126
       126
       -
           "edge: max length 255", `Quick, test_edge_max_length;

     

       127
       127
       -
           "edge: over max length 256", `Quick, test_edge_over_max_length;

     

       128
       128
       -
         ]

     

       129
       129
       -
       end

     

       130
       130
       -
       

     

       131
       131
       -
       (* Int53 tests *)

     

       132
       132
       -
       module Int53_tests = struct

     

       133
       133
       -
         open Jmap_proto

     

       134
       134
       -
       

     

       135
       135
       -
         let test_zero () =

     

       136
       136
       -
           match decode Int53.Signed.jsont "0" with

     

       137
       137
       -
           | Ok n -> Alcotest.(check int64) "value" 0L n

     

       138
       138
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       139
       139
       -
       

     

       140
       140
       -
         let test_positive () =

     

       141
       141
       -
           match decode Int53.Signed.jsont "12345" with

     

       142
       142
       -
           | Ok n -> Alcotest.(check int64) "value" 12345L n

     

       143
       143
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       144
       144
       -
       

     

       145
       145
       -
         let test_negative () =

     

       146
       146
       -
           match decode Int53.Signed.jsont "-12345" with

     

       147
       147
       -
           | Ok n -> Alcotest.(check int64) "value" (-12345L) n

     

       148
       148
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       149
       149
       -
       

     

       150
       150
       -
         let test_max_safe () =

     

       151
       151
       -
           match decode Int53.Signed.jsont "9007199254740991" with

     

       152
       152
       -
           | Ok n -> Alcotest.(check int64) "value" 9007199254740991L n

     

       153
       153
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       154
       154
       -
       

     

       155
       155
       -
         let test_min_safe () =

     

       156
       156
       -
           match decode Int53.Signed.jsont "-9007199254740991" with

     

       157
       157
       -
           | Ok n -> Alcotest.(check int64) "value" (-9007199254740991L) n

     

       158
       158
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       159
       159
       -
       

     

       160
       160
       -
         let test_over_max_safe () =

     

       161
       161
       -
           match decode Int53.Signed.jsont "9007199254740992" with

     

       162
       162
       -
           | Ok _ -> Alcotest.fail "expected failure for over max safe"

     

       163
       163
       -
           | Error _ -> ()

     

       164
       164
       -
       

     

       165
       165
       -
         let test_under_min_safe () =

     

       166
       166
       -
           match decode Int53.Signed.jsont "-9007199254740992" with

     

       167
       167
       -
           | Ok _ -> Alcotest.fail "expected failure for under min safe"

     

       168
       168
       -
           | Error _ -> ()

     

       169
       169
       -
       

     

       170
       170
       -
         let test_unsigned_zero () =

     

       171
       171
       -
           match decode Int53.Unsigned.jsont "0" with

     

       172
       172
       -
           | Ok n -> Alcotest.(check int64) "value" 0L n

     

       173
       173
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       174
       174
       -
       

     

       175
       175
       -
         let test_unsigned_max () =

     

       176
       176
       -
           match decode Int53.Unsigned.jsont "9007199254740991" with

     

       177
       177
       -
           | Ok n -> Alcotest.(check int64) "value" 9007199254740991L n

     

       178
       178
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       179
       179
       -
       

     

       180
       180
       -
         let test_unsigned_negative () =

     

       181
       181
       -
           match decode Int53.Unsigned.jsont "-1" with

     

       182
       182
       -
           | Ok _ -> Alcotest.fail "expected failure for negative unsigned"

     

       183
       183
       -
           | Error _ -> ()

     

       184
       184
       -
       

     

       185
       185
       -
         let tests = [

     

       186
       186
       -
           "signed: zero", `Quick, test_zero;

     

       187
       187
       -
           "signed: positive", `Quick, test_positive;

     

       188
       188
       -
           "signed: negative", `Quick, test_negative;

     

       189
       189
       -
           "signed: max safe", `Quick, test_max_safe;

     

       190
       190
       -
           "signed: min safe", `Quick, test_min_safe;

     

       191
       191
       -
           "signed: over max safe", `Quick, test_over_max_safe;

     

       192
       192
       -
           "signed: under min safe", `Quick, test_under_min_safe;

     

       193
       193
       -
           "unsigned: zero", `Quick, test_unsigned_zero;

     

       194
       194
       -
           "unsigned: max", `Quick, test_unsigned_max;

     

       195
       195
       -
           "unsigned: negative fails", `Quick, test_unsigned_negative;

     

       196
       196
       -
         ]

     

       197
       197
       -
       end

     

       198
       198
       -
       

     

       199
       199
       -
       (* Date tests *)

     

       200
       200
       -
       module Date_tests = struct

     

       201
       201
       -
         open Jmap_proto

     

       202
       202
       -
       

     

       203
       203
       -
         let test_utc_z () =

     

       204
       204
       -
           match decode Date.Utc.jsont "\"2024-01-15T10:30:00Z\"" with

     

       205
       205
       -
           | Ok _ -> ()

     

       206
       206
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       207
       207
       -
       

     

       208
       208
       -
         let test_rfc3339_with_offset () =

     

       209
       209
       -
           match decode Date.Rfc3339.jsont "\"2024-01-15T10:30:00+05:30\"" with

     

       210
       210
       -
           | Ok _ -> ()

     

       211
       211
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       212
       212
       -
       

     

       213
       213
       -
         let test_with_milliseconds () =

     

       214
       214
       -
           match decode Date.Rfc3339.jsont "\"2024-01-15T10:30:00.123Z\"" with

     

       215
       215
       -
           | Ok _ -> ()

     

       216
       216
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       217
       217
       -
       

     

       218
       218
       -
         let test_invalid_format () =

     

       219
       219
       -
           match decode Date.Rfc3339.jsont "\"January 15, 2024\"" with

     

       220
       220
       -
           | Ok _ -> Alcotest.fail "expected failure for invalid format"

     

       221
       221
       -
           | Error _ -> ()

     

       222
       222
       -
       

     

       223
       223
       -
         let test_not_string () =

     

       224
       224
       -
           match decode Date.Rfc3339.jsont "1705315800" with

     

       225
       225
       -
           | Ok _ -> Alcotest.fail "expected failure for non-string"

     

       226
       226
       -
           | Error _ -> ()

     

       227
       227
       -
       

     

       228
       228
       -
         let tests = [

     

       229
       229
       -
           "utc: Z suffix", `Quick, test_utc_z;

     

       230
       230
       -
           "rfc3339: with offset", `Quick, test_rfc3339_with_offset;

     

       231
       231
       -
           "rfc3339: with milliseconds", `Quick, test_with_milliseconds;

     

       232
       232
       -
           "invalid: bad format", `Quick, test_invalid_format;

     

       233
       233
       -
           "invalid: not string", `Quick, test_not_string;

     

       234
       234
       -
         ]

     

       235
       235
       -
       end

     

       236
       236
       -
       

     

       237
       237
       -
       (* Session tests *)

     

       238
       238
       -
       module Session_tests = struct

     

       239
       239
       -
         open Jmap_proto

     

       240
       240
       -
       

     

       241
       241
       -
         let test_minimal () =

     

       242
       242
       -
           test_decode_success "minimal session" Session.jsont "session/valid/minimal.json" ()

     

       243
       243
       -
       

     

       244
       244
       -
         let test_with_mail () =

     

       245
       245
       -
           test_decode_success "session with mail" Session.jsont "session/valid/with_mail.json" ()

     

       246
       246
       -
       

     

       247
       247
       -
         let test_roundtrip_minimal () =

     

       248
       248
       -
           test_roundtrip "minimal session roundtrip" Session.jsont "session/valid/minimal.json" ()

     

       249
       249
       -
       

     

       250
       250
       -
         let test_values () =

     

       251
       251
       -
           let json = read_file "session/valid/minimal.json" in

     

       252
       252
       -
           match decode Session.jsont json with

     

       253
       253
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       254
       254
       -
           | Ok session ->

     

       255
       255
       -
               Alcotest.(check string) "username" "test@example.com" (Session.username session);

     

       256
       256
       -
               Alcotest.(check string) "apiUrl" "https://api.example.com/jmap/" (Session.api_url session);

     

       257
       257
       -
               Alcotest.(check string) "state" "abc123" (Session.state session);

     

       258
       258
       -
               Alcotest.(check bool) "has core capability" true

     

       259
       259
       -
                 (Session.has_capability Capability.core session)

     

       260
       260
       -
       

     

       261
       261
       -
         let test_with_accounts () =

     

       262
       262
       -
           test_decode_success "with accounts" Session.jsont "session/valid/with_accounts.json" ()

     

       263
       263
       -
       

     

       264
       264
       -
         let test_empty_accounts () =

     

       265
       265
       -
           test_decode_success "empty accounts" Session.jsont "session/edge/empty_accounts.json" ()

     

       266
       266
       -
       

     

       267
       267
       -
         let test_accounts_values () =

     

       268
       268
       -
           let json = read_file "session/valid/with_accounts.json" in

     

       269
       269
       -
           match decode Session.jsont json with

     

       270
       270
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       271
       271
       -
           | Ok session ->

     

       272
       272
       -
               Alcotest.(check int) "accounts count" 2 (List.length (Session.accounts session));

     

       273
       273
       -
               Alcotest.(check int) "primary_accounts count" 2 (List.length (Session.primary_accounts session))

     

       274
       274
       -
       

     

       275
       275
       -
         let tests = [

     

       276
       276
       -
           "valid: minimal", `Quick, test_minimal;

     

       277
       277
       -
           "valid: with mail", `Quick, test_with_mail;

     

       278
       278
       -
           "valid: with accounts", `Quick, test_with_accounts;

     

       279
       279
       -
           "edge: empty accounts", `Quick, test_empty_accounts;

     

       280
       280
       -
           "roundtrip: minimal", `Quick, test_roundtrip_minimal;

     

       281
       281
       -
           "values: minimal", `Quick, test_values;

     

       282
       282
       -
           "values: accounts", `Quick, test_accounts_values;

     

       283
       283
       -
         ]

     

       284
       284
       -
       end

     

       285
       285
       -
       

     

       286
       286
       -
       (* Request tests *)

     

       287
       287
       -
       module Request_tests = struct

     

       288
       288
       -
         open Jmap_proto

     

       289
       289
       -
       

     

       290
       290
       -
         let test_single_method () =

     

       291
       291
       -
           test_decode_success "single method" Request.jsont "request/valid/single_method.json" ()

     

       292
       292
       -
       

     

       293
       293
       -
         let test_multiple_methods () =

     

       294
       294
       -
           test_decode_success "multiple methods" Request.jsont "request/valid/multiple_methods.json" ()

     

       295
       295
       -
       

     

       296
       296
       -
         let test_with_created_ids () =

     

       297
       297
       -
           test_decode_success "with created ids" Request.jsont "request/valid/with_created_ids.json" ()

     

       298
       298
       -
       

     

       299
       299
       -
         let test_empty_methods () =

     

       300
       300
       -
           test_decode_success "empty methods" Request.jsont "request/valid/empty_methods.json" ()

     

       301
       301
       -
       

     

       302
       302
       -
         let test_values () =

     

       303
       303
       -
           let json = read_file "request/valid/single_method.json" in

     

       304
       304
       -
           match decode Request.jsont json with

     

       305
       305
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       306
       306
       -
           | Ok request ->

     

       307
       307
       -
               Alcotest.(check int) "using count" 2 (List.length (Request.using request));

     

       308
       308
       -
               Alcotest.(check int) "method calls count" 1 (List.length (Request.method_calls request))

     

       309
       309
       -
       

     

       310
       310
       -
         let test_roundtrip () =

     

       311
       311
       -
           test_roundtrip "single method roundtrip" Request.jsont "request/valid/single_method.json" ()

     

       312
       312
       -
       

     

       313
       313
       -
         let tests = [

     

       314
       314
       -
           "valid: single method", `Quick, test_single_method;

     

       315
       315
       -
           "valid: multiple methods", `Quick, test_multiple_methods;

     

       316
       316
       -
           "valid: with created ids", `Quick, test_with_created_ids;

     

       317
       317
       -
           "valid: empty methods", `Quick, test_empty_methods;

     

       318
       318
       -
           "values: single method", `Quick, test_values;

     

       319
       319
       -
           "roundtrip: single method", `Quick, test_roundtrip;

     

       320
       320
       -
         ]

     

       321
       321
       -
       end

     

       322
       322
       -
       

     

       323
       323
       -
       (* Response tests *)

     

       324
       324
       -
       module Response_tests = struct

     

       325
       325
       -
         open Jmap_proto

     

       326
       326
       -
       

     

       327
       327
       -
         let test_success () =

     

       328
       328
       -
           test_decode_success "success" Response.jsont "response/valid/success.json" ()

     

       329
       329
       -
       

     

       330
       330
       -
         let test_with_created_ids () =

     

       331
       331
       -
           test_decode_success "with created ids" Response.jsont "response/valid/with_created_ids.json" ()

     

       332
       332
       -
       

     

       333
       333
       -
         let test_with_error () =

     

       334
       334
       -
           test_decode_success "with error" Response.jsont "response/valid/with_error.json" ()

     

       335
       335
       -
       

     

       336
       336
       -
         let test_multiple_responses () =

     

       337
       337
       -
           test_decode_success "multiple responses" Response.jsont "response/valid/multiple_responses.json" ()

     

       338
       338
       -
       

     

       339
       339
       -
         let test_values () =

     

       340
       340
       -
           let json = read_file "response/valid/success.json" in

     

       341
       341
       -
           match decode Response.jsont json with

     

       342
       342
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       343
       343
       -
           | Ok response ->

     

       344
       344
       -
               Alcotest.(check string) "session state" "session123" (Response.session_state response);

     

       345
       345
       -
               Alcotest.(check int) "method responses count" 1 (List.length (Response.method_responses response))

     

       346
       346
       -
       

     

       347
       347
       -
         let test_roundtrip () =

     

       348
       348
       -
           test_roundtrip "success roundtrip" Response.jsont "response/valid/success.json" ()

     

       349
       349
       -
       

     

       350
       350
       -
         let tests = [

     

       351
       351
       -
           "valid: success", `Quick, test_success;

     

       352
       352
       -
           "valid: with created ids", `Quick, test_with_created_ids;

     

       353
       353
       -
           "valid: with error", `Quick, test_with_error;

     

       354
       354
       -
           "valid: multiple responses", `Quick, test_multiple_responses;

     

       355
       355
       -
           "values: success", `Quick, test_values;

     

       356
       356
       -
           "roundtrip: success", `Quick, test_roundtrip;

     

       357
       357
       -
         ]

     

       358
       358
       -
       end

     

       359
       359
       -
       

     

       360
       360
       -
       (* Invocation tests *)

     

       361
       361
       -
       module Invocation_tests = struct

     

       362
       362
       -
         open Jmap_proto

     

       363
       363
       -
       

     

       364
       364
       -
         let test_get () =

     

       365
       365
       -
           test_decode_success "get" Invocation.jsont "invocation/valid/get.json" ()

     

       366
       366
       -
       

     

       367
       367
       -
         let test_set () =

     

       368
       368
       -
           test_decode_success "set" Invocation.jsont "invocation/valid/set.json" ()

     

       369
       369
       -
       

     

       370
       370
       -
         let test_query () =

     

       371
       371
       -
           test_decode_success "query" Invocation.jsont "invocation/valid/query.json" ()

     

       372
       372
       -
       

     

       373
       373
       -
         let test_values () =

     

       374
       374
       -
           let json = read_file "invocation/valid/get.json" in

     

       375
       375
       -
           match decode Invocation.jsont json with

     

       376
       376
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       377
       377
       -
           | Ok inv ->

     

       378
       378
       -
               Alcotest.(check string) "name" "Email/get" (Invocation.name inv);

     

       379
       379
       -
               Alcotest.(check string) "method call id" "call-001" (Invocation.method_call_id inv)

     

       380
       380
       -
       

     

       381
       381
       -
         let test_invalid_not_array () =

     

       382
       382
       -
           test_decode_failure "not array" Invocation.jsont "invocation/invalid/not_array.json" ()

     

       383
       383
       -
       

     

       384
       384
       -
         let test_invalid_wrong_length () =

     

       385
       385
       -
           test_decode_failure "wrong length" Invocation.jsont "invocation/invalid/wrong_length.json" ()

     

       386
       386
       -
       

     

       387
       387
       -
         let tests = [

     

       388
       388
       -
           "valid: get", `Quick, test_get;

     

       389
       389
       -
           "valid: set", `Quick, test_set;

     

       390
       390
       -
           "valid: query", `Quick, test_query;

     

       391
       391
       -
           "values: get", `Quick, test_values;

     

       392
       392
       -
           "invalid: not array", `Quick, test_invalid_not_array;

     

       393
       393
       -
           "invalid: wrong length", `Quick, test_invalid_wrong_length;

     

       394
       394
       -
         ]

     

       395
       395
       -
       end

     

       396
       396
       -
       

     

       397
       397
       -
       (* Capability tests *)

     

       398
       398
       -
       module Capability_tests = struct

     

       399
       399
       -
         open Jmap_proto

     

       400
       400
       -
       

     

       401
       401
       -
         let test_core () =

     

       402
       402
       -
           test_decode_success "core" Capability.Core.jsont "capability/valid/core.json" ()

     

       403
       403
       -
       

     

       404
       404
       -
         let test_mail () =

     

       405
       405
       -
           test_decode_success "mail" Capability.Mail.jsont "capability/valid/mail.json" ()

     

       406
       406
       -
       

     

       407
       407
       -
         let test_submission () =

     

       408
       408
       -
           test_decode_success "submission" Capability.Submission.jsont "capability/valid/submission.json" ()

     

       409
       409
       -
       

     

       410
       410
       -
         let test_core_values () =

     

       411
       411
       -
           let json = read_file "capability/valid/core.json" in

     

       412
       412
       -
           match decode Capability.Core.jsont json with

     

       413
       413
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       414
       414
       -
           | Ok cap ->

     

       415
       415
       -
               Alcotest.(check int64) "maxSizeUpload" 50000000L (Capability.Core.max_size_upload cap);

     

       416
       416
       -
               Alcotest.(check int) "maxConcurrentUpload" 4 (Capability.Core.max_concurrent_upload cap);

     

       417
       417
       -
               Alcotest.(check int) "maxCallsInRequest" 16 (Capability.Core.max_calls_in_request cap)

     

       418
       418
       -
       

     

       419
       419
       -
         let test_mail_values () =

     

       420
       420
       -
           let json = read_file "capability/valid/mail.json" in

     

       421
       421
       -
           match decode Capability.Mail.jsont json with

     

       422
       422
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       423
       423
       -
           | Ok cap ->

     

       424
       424
       -
               Alcotest.(check int64) "maxSizeMailboxName" 490L (Capability.Mail.max_size_mailbox_name cap);

     

       425
       425
       -
               Alcotest.(check bool) "mayCreateTopLevelMailbox" true (Capability.Mail.may_create_top_level_mailbox cap)

     

       426
       426
       -
       

     

       427
       427
       -
         let tests = [

     

       428
       428
       -
           "valid: core", `Quick, test_core;

     

       429
       429
       -
           "valid: mail", `Quick, test_mail;

     

       430
       430
       -
           "valid: submission", `Quick, test_submission;

     

       431
       431
       -
           "values: core", `Quick, test_core_values;

     

       432
       432
       -
           "values: mail", `Quick, test_mail_values;

     

       433
       433
       -
         ]

     

       434
       434
       -
       end

     

       435
       435
       -
       

     

       436
       436
       -
       (* Method args/response tests *)

     

       437
       437
       -
       module Method_tests = struct

     

       438
       438
       -
         open Jmap_proto

     

       439
       439
       -
       

     

       440
       440
       -
         let test_get_args () =

     

       441
       441
       -
           test_decode_success "get_args" Method.get_args_jsont "method/valid/get_args.json" ()

     

       442
       442
       -
       

     

       443
       443
       -
         let test_get_args_minimal () =

     

       444
       444
       -
           test_decode_success "get_args_minimal" Method.get_args_jsont "method/valid/get_args_minimal.json" ()

     

       445
       445
       -
       

     

       446
       446
       -
         let test_query_response () =

     

       447
       447
       -
           test_decode_success "query_response" Method.query_response_jsont "method/valid/query_response.json" ()

     

       448
       448
       -
       

     

       449
       449
       -
         let test_changes_response () =

     

       450
       450
       -
           test_decode_success "changes_response" Method.changes_response_jsont "method/valid/changes_response.json" ()

     

       451
       451
       -
       

     

       452
       452
       -
         let test_get_args_values () =

     

       453
       453
       -
           let json = read_file "method/valid/get_args.json" in

     

       454
       454
       -
           match decode Method.get_args_jsont json with

     

       455
       455
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       456
       456
       -
           | Ok args ->

     

       457
       457
       -
               Alcotest.(check string) "accountId" "acc1" (Id.to_string args.account_id);

     

       458
       458
       -
               Alcotest.(check (option (list string))) "properties" (Some ["id"; "name"; "role"]) args.properties

     

       459
       459
       -
       

     

       460
       460
       -
         let test_query_response_values () =

     

       461
       461
       -
           let json = read_file "method/valid/query_response.json" in

     

       462
       462
       -
           match decode Method.query_response_jsont json with

     

       463
       463
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       464
       464
       -
           | Ok resp ->

     

       465
       465
       -
               Alcotest.(check int) "ids count" 5 (List.length resp.ids);

     

       466
       466
       -
               Alcotest.(check int64) "position" 0L resp.position;

     

       467
       467
       -
               Alcotest.(check bool) "canCalculateChanges" true resp.can_calculate_changes;

     

       468
       468
       -
               Alcotest.(check (option int64)) "total" (Some 250L) resp.total

     

       469
       469
       -
       

     

       470
       470
       -
         let test_changes_response_values () =

     

       471
       471
       -
           let json = read_file "method/valid/changes_response.json" in

     

       472
       472
       -
           match decode Method.changes_response_jsont json with

     

       473
       473
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       474
       474
       -
           | Ok resp ->

     

       475
       475
       -
               Alcotest.(check string) "oldState" "old123" resp.old_state;

     

       476
       476
       -
               Alcotest.(check string) "newState" "new456" resp.new_state;

     

       477
       477
       -
               Alcotest.(check bool) "hasMoreChanges" false resp.has_more_changes;

     

       478
       478
       -
               Alcotest.(check int) "created count" 2 (List.length resp.created);

     

       479
       479
       -
               Alcotest.(check int) "destroyed count" 2 (List.length resp.destroyed)

     

       480
       480
       -
       

     

       481
       481
       -
         let tests = [

     

       482
       482
       -
           "valid: get_args", `Quick, test_get_args;

     

       483
       483
       -
           "valid: get_args_minimal", `Quick, test_get_args_minimal;

     

       484
       484
       -
           "valid: query_response", `Quick, test_query_response;

     

       485
       485
       -
           "valid: changes_response", `Quick, test_changes_response;

     

       486
       486
       -
           "values: get_args", `Quick, test_get_args_values;

     

       487
       487
       -
           "values: query_response", `Quick, test_query_response_values;

     

       488
       488
       -
           "values: changes_response", `Quick, test_changes_response_values;

     

       489
       489
       -
         ]

     

       490
       490
       -
       end

     

       491
       491
       -
       

     

       492
       492
       -
       (* Error tests *)

     

       493
       493
       -
       module Error_tests = struct

     

       494
       494
       -
         open Jmap_proto

     

       495
       495
       -
       

     

       496
       496
       -
         let test_method_error () =

     

       497
       497
       -
           test_decode_success "method_error" Error.method_error_jsont "error/valid/method_error.json" ()

     

       498
       498
       -
       

     

       499
       499
       -
         let test_set_error () =

     

       500
       500
       -
           test_decode_success "set_error" Error.set_error_jsont "error/valid/set_error.json" ()

     

       501
       501
       -
       

     

       502
       502
       -
         let test_request_error () =

     

       503
       503
       -
           test_decode_success "request_error" Error.Request_error.jsont "error/valid/request_error.json" ()

     

       504
       504
       -
       

     

       505
       505
       -
         let method_error_type_testable =

     

       506
       506
       -
           Alcotest.testable

     

       507
       507
       -
             (fun fmt t -> Format.pp_print_string fmt (Error.method_error_type_to_string t))

     

       508
       508
       -
             (=)

     

       509
       509
       -
       

     

       510
       510
       -
         let test_method_error_values () =

     

       511
       511
       -
           let json = read_file "error/valid/method_error.json" in

     

       512
       512
       -
           match decode Error.method_error_jsont json with

     

       513
       513
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       514
       514
       -
           | Ok err ->

     

       515
       515
       -
               Alcotest.(check method_error_type_testable) "type" Error.Unknown_method err.type_

     

       516
       516
       -
       

     

       517
       517
       -
         (* Additional error type tests *)

     

       518
       518
       -
         let test_set_error_forbidden () =

     

       519
       519
       -
           test_decode_success "set_error_forbidden" Error.set_error_jsont "error/valid/set_error_forbidden.json" ()

     

       520
       520
       -
       

     

       521
       521
       -
         let test_set_error_not_found () =

     

       522
       522
       -
           test_decode_success "set_error_not_found" Error.set_error_jsont "error/valid/set_error_not_found.json" ()

     

       523
       523
       -
       

     

       524
       524
       -
         let test_set_error_invalid_properties () =

     

       525
       525
       -
           test_decode_success "set_error_invalid_properties" Error.set_error_jsont "error/valid/set_error_invalid_properties.json" ()

     

       526
       526
       -
       

     

       527
       527
       -
         let test_set_error_singleton () =

     

       528
       528
       -
           test_decode_success "set_error_singleton" Error.set_error_jsont "error/valid/set_error_singleton.json" ()

     

       529
       529
       -
       

     

       530
       530
       -
         let test_set_error_over_quota () =

     

       531
       531
       -
           test_decode_success "set_error_over_quota" Error.set_error_jsont "error/valid/set_error_over_quota.json" ()

     

       532
       532
       -
       

     

       533
       533
       -
         let test_method_error_invalid_arguments () =

     

       534
       534
       -
           test_decode_success "method_error_invalid_arguments" Error.method_error_jsont "error/valid/method_error_invalid_arguments.json" ()

     

       535
       535
       -
       

     

       536
       536
       -
         let test_method_error_server_fail () =

     

       537
       537
       -
           test_decode_success "method_error_server_fail" Error.method_error_jsont "error/valid/method_error_server_fail.json" ()

     

       538
       538
       -
       

     

       539
       539
       -
         let test_method_error_account_not_found () =

     

       540
       540
       -
           test_decode_success "method_error_account_not_found" Error.method_error_jsont "error/valid/method_error_account_not_found.json" ()

     

       541
       541
       -
       

     

       542
       542
       -
         let test_method_error_forbidden () =

     

       543
       543
       -
           test_decode_success "method_error_forbidden" Error.method_error_jsont "error/valid/method_error_forbidden.json" ()

     

       544
       544
       -
       

     

       545
       545
       -
         let test_method_error_account_read_only () =

     

       546
       546
       -
           test_decode_success "method_error_account_read_only" Error.method_error_jsont "error/valid/method_error_account_read_only.json" ()

     

       547
       547
       -
       

     

       548
       548
       -
         let test_request_error_not_json () =

     

       549
       549
       -
           test_decode_success "request_error_not_json" Error.Request_error.jsont "error/valid/request_error_not_json.json" ()

     

       550
       550
       -
       

     

       551
       551
       -
         let test_request_error_limit () =

     

       552
       552
       -
           test_decode_success "request_error_limit" Error.Request_error.jsont "error/valid/request_error_limit.json" ()

     

       553
       553
       -
       

     

       554
       554
       -
         let set_error_type_testable =

     

       555
       555
       -
           Alcotest.testable

     

       556
       556
       -
             (fun fmt t -> Format.pp_print_string fmt (Error.set_error_type_to_string t))

     

       557
       557
       -
             (=)

     

       558
       558
       -
       

     

       559
       559
       -
         let test_set_error_types () =

     

       560
       560
       -
           let json = read_file "error/valid/set_error_invalid_properties.json" in

     

       561
       561
       -
           match decode Error.set_error_jsont json with

     

       562
       562
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       563
       563
       -
           | Ok err ->

     

       564
       564
       -
               Alcotest.(check set_error_type_testable) "type" Error.Invalid_properties err.Error.type_;

     

       565
       565
       -
               match err.Error.properties with

     

       566
       566
       -
               | None -> Alcotest.fail "expected properties"

     

       567
       567
       -
               | Some props -> Alcotest.(check int) "properties count" 2 (List.length props)

     

       568
       568
       -
       

     

       569
       569
       -
         let tests = [

     

       570
       570
       -
           "valid: method_error", `Quick, test_method_error;

     

       571
       571
       -
           "valid: set_error", `Quick, test_set_error;

     

       572
       572
       -
           "valid: request_error", `Quick, test_request_error;

     

       573
       573
       -
           "valid: set_error forbidden", `Quick, test_set_error_forbidden;

     

       574
       574
       -
           "valid: set_error notFound", `Quick, test_set_error_not_found;

     

       575
       575
       -
           "valid: set_error invalidProperties", `Quick, test_set_error_invalid_properties;

     

       576
       576
       -
           "valid: set_error singleton", `Quick, test_set_error_singleton;

     

       577
       577
       -
           "valid: set_error overQuota", `Quick, test_set_error_over_quota;

     

       578
       578
       -
           "valid: method_error invalidArguments", `Quick, test_method_error_invalid_arguments;

     

       579
       579
       -
           "valid: method_error serverFail", `Quick, test_method_error_server_fail;

     

       580
       580
       -
           "valid: method_error accountNotFound", `Quick, test_method_error_account_not_found;

     

       581
       581
       -
           "valid: method_error forbidden", `Quick, test_method_error_forbidden;

     

       582
       582
       -
           "valid: method_error accountReadOnly", `Quick, test_method_error_account_read_only;

     

       583
       583
       -
           "valid: request_error notJSON", `Quick, test_request_error_not_json;

     

       584
       584
       -
           "valid: request_error limit", `Quick, test_request_error_limit;

     

       585
       585
       -
           "values: method_error", `Quick, test_method_error_values;

     

       586
       586
       -
           "values: set_error types", `Quick, test_set_error_types;

     

       587
       587
       -
         ]

     

       588
       588
       -
       end

     

       589
       589
       -
       

     

       590
       590
       -
       (* Mailbox tests *)

     

       591
       591
       -
       module Mailbox_tests = struct

     

       592
       592
       -
         open Jmap_mail

     

       593
       593
       -
       

     

       594
       594
       -
         let role_testable =

     

       595
       595
       -
           Alcotest.testable

     

       596
       596
       -
             (fun fmt t -> Format.pp_print_string fmt (Mailbox.role_to_string t))

     

       597
       597
       -
             (=)

     

       598
       598
       -
       

     

       599
       599
       -
         let test_simple () =

     

       600
       600
       -
           test_decode_success "simple" Mailbox.jsont "mail/mailbox/valid/simple.json" ()

     

       601
       601
       -
       

     

       602
       602
       -
         let test_nested () =

     

       603
       603
       -
           test_decode_success "nested" Mailbox.jsont "mail/mailbox/valid/nested.json" ()

     

       604
       604
       -
       

     

       605
       605
       -
         let test_values () =

     

       606
       606
       -
           let json = read_file "mail/mailbox/valid/simple.json" in

     

       607
       607
       -
           match decode Mailbox.jsont json with

     

       608
       608
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       609
       609
       -
           | Ok mb ->

     

       610
       610
       -
               Alcotest.(check string) "id" "mb1" (Jmap_proto.Id.to_string (Mailbox.id mb));

     

       611
       611
       -
               Alcotest.(check string) "name" "Inbox" (Mailbox.name mb);

     

       612
       612
       -
               Alcotest.(check (option role_testable)) "role" (Some Mailbox.Inbox) (Mailbox.role mb);

     

       613
       613
       -
               Alcotest.(check int64) "totalEmails" 150L (Mailbox.total_emails mb);

     

       614
       614
       -
               Alcotest.(check int64) "unreadEmails" 5L (Mailbox.unread_emails mb)

     

       615
       615
       -
       

     

       616
       616
       -
         let test_roundtrip () =

     

       617
       617
       -
           test_roundtrip "simple roundtrip" Mailbox.jsont "mail/mailbox/valid/simple.json" ()

     

       618
       618
       -
       

     

       619
       619
       -
         let test_with_all_roles () =

     

       620
       620
       -
           test_decode_success "with all roles" Mailbox.jsont "mail/mailbox/valid/with_all_roles.json" ()

     

       621
       621
       -
       

     

       622
       622
       -
         let test_all_rights_false () =

     

       623
       623
       -
           test_decode_success "all rights false" Mailbox.jsont "mail/mailbox/edge/all_rights_false.json" ()

     

       624
       624
       -
       

     

       625
       625
       -
         let test_roles_values () =

     

       626
       626
       -
           let json = read_file "mail/mailbox/valid/with_all_roles.json" in

     

       627
       627
       -
           match decode Mailbox.jsont json with

     

       628
       628
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       629
       629
       -
           | Ok mb ->

     

       630
       630
       -
               Alcotest.(check (option role_testable)) "role" (Some Mailbox.Archive) (Mailbox.role mb);

     

       631
       631
       -
               Alcotest.(check int64) "totalEmails" 1000L (Mailbox.total_emails mb)

     

       632
       632
       -
       

     

       633
       633
       -
         let tests = [

     

       634
       634
       -
           "valid: simple", `Quick, test_simple;

     

       635
       635
       -
           "valid: nested", `Quick, test_nested;

     

       636
       636
       -
           "valid: with all roles", `Quick, test_with_all_roles;

     

       637
       637
       -
           "edge: all rights false", `Quick, test_all_rights_false;

     

       638
       638
       -
           "values: simple", `Quick, test_values;

     

       639
       639
       -
           "values: roles", `Quick, test_roles_values;

     

       640
       640
       -
           "roundtrip: simple", `Quick, test_roundtrip;

     

       641
       641
       -
         ]

     

       642
       642
       -
       end

     

       643
       643
       -
       

     

       644
       644
       -
       (* Email tests *)

     

       645
       645
       -
       module Email_tests = struct

     

       646
       646
       -
         open Jmap_mail

     

       647
       647
       -
       

     

       648
       648
       -
         let test_minimal () =

     

       649
       649
       -
           test_decode_success "minimal" Email.jsont "mail/email/valid/minimal.json" ()

     

       650
       650
       -
       

     

       651
       651
       -
         let test_full () =

     

       652
       652
       -
           test_decode_success "full" Email.jsont "mail/email/valid/full.json" ()

     

       653
       653
       -
       

     

       654
       654
       -
         let test_with_headers () =

     

       655
       655
       -
           test_decode_success "with_headers" Email.jsont "mail/email/valid/with_headers.json" ()

     

       656
       656
       -
       

     

       657
       657
       -
         let test_minimal_values () =

     

       658
       658
       -
           let json = read_file "mail/email/valid/minimal.json" in

     

       659
       659
       -
           match decode Email.jsont json with

     

       660
       660
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       661
       661
       -
           | Ok email ->

     

       662
       662
       -
               Alcotest.(check string) "id" "e1" (Jmap_proto.Id.to_string (Email.id email));

     

       663
       663
       -
               Alcotest.(check string) "blobId" "blob1" (Jmap_proto.Id.to_string (Email.blob_id email));

     

       664
       664
       -
               Alcotest.(check int64) "size" 1024L (Email.size email)

     

       665
       665
       -
       

     

       666
       666
       -
         let test_full_values () =

     

       667
       667
       -
           let json = read_file "mail/email/valid/full.json" in

     

       668
       668
       -
           match decode Email.jsont json with

     

       669
       669
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       670
       670
       -
           | Ok email ->

     

       671
       671
       -
               Alcotest.(check (option string)) "subject" (Some "Re: Important meeting") (Email.subject email);

     

       672
       672
       -
               Alcotest.(check bool) "hasAttachment" true (Email.has_attachment email);

     

       673
       673
       -
               (* Check from address *)

     

       674
       674
       -
               match Email.from email with

     

       675
       675
       -
               | None -> Alcotest.fail "expected from address"

     

       676
       676
       -
               | Some addrs ->

     

       677
       677
       -
                   Alcotest.(check int) "from count" 1 (List.length addrs);

     

       678
       678
       -
                   let addr = List.hd addrs in

     

       679
       679
       -
                   Alcotest.(check (option string)) "from name" (Some "Alice Smith") (Email_address.name addr);

     

       680
       680
       -
                   Alcotest.(check string) "from email" "alice@example.com" (Email_address.email addr)

     

       681
       681
       -
       

     

       682
       682
       -
         let test_with_keywords () =

     

       683
       683
       -
           test_decode_success "with keywords" Email.jsont "mail/email/valid/with_keywords.json" ()

     

       684
       684
       -
       

     

       685
       685
       -
         let test_multiple_mailboxes () =

     

       686
       686
       -
           test_decode_success "multiple mailboxes" Email.jsont "mail/email/valid/multiple_mailboxes.json" ()

     

       687
       687
       -
       

     

       688
       688
       -
         let test_draft_email () =

     

       689
       689
       -
           test_decode_success "draft email" Email.jsont "mail/email/valid/draft_email.json" ()

     

       690
       690
       -
       

     

       691
       691
       -
         let test_with_all_system_keywords () =

     

       692
       692
       -
           test_decode_success "all system keywords" Email.jsont "mail/email/valid/with_all_system_keywords.json" ()

     

       693
       693
       -
       

     

       694
       694
       -
         let test_empty_keywords () =

     

       695
       695
       -
           test_decode_success "empty keywords" Email.jsont "mail/email/edge/empty_keywords.json" ()

     

       696
       696
       -
       

     

       697
       697
       -
         let test_with_message_ids () =

     

       698
       698
       -
           test_decode_success "with message ids" Email.jsont "mail/email/valid/with_message_ids.json" ()

     

       699
       699
       -
       

     

       700
       700
       -
         let test_keywords_values () =

     

       701
       701
       -
           let json = read_file "mail/email/valid/with_keywords.json" in

     

       702
       702
       -
           match decode Email.jsont json with

     

       703
       703
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       704
       704
       -
           | Ok email ->

     

       705
       705
       -
               let keywords = Email.keywords email in

     

       706
       706
       -
               Alcotest.(check int) "keywords count" 3 (List.length keywords);

     

       707
       707
       -
               Alcotest.(check bool) "$seen present" true (List.mem_assoc "$seen" keywords);

     

       708
       708
       -
               Alcotest.(check bool) "$flagged present" true (List.mem_assoc "$flagged" keywords)

     

       709
       709
       -
       

     

       710
       710
       -
         let test_mailbox_ids_values () =

     

       711
       711
       -
           let json = read_file "mail/email/valid/multiple_mailboxes.json" in

     

       712
       712
       -
           match decode Email.jsont json with

     

       713
       713
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       714
       714
       -
           | Ok email ->

     

       715
       715
       -
               let mailbox_ids = Email.mailbox_ids email in

     

       716
       716
       -
               Alcotest.(check int) "mailboxIds count" 3 (List.length mailbox_ids)

     

       717
       717
       -
       

     

       718
       718
       -
         let tests = [

     

       719
       719
       -
           "valid: minimal", `Quick, test_minimal;

     

       720
       720
       -
           "valid: full", `Quick, test_full;

     

       721
       721
       -
           "valid: with_headers", `Quick, test_with_headers;

     

       722
       722
       -
           "valid: with keywords", `Quick, test_with_keywords;

     

       723
       723
       -
           "valid: multiple mailboxes", `Quick, test_multiple_mailboxes;

     

       724
       724
       -
           "valid: draft email", `Quick, test_draft_email;

     

       725
       725
       -
           "valid: all system keywords", `Quick, test_with_all_system_keywords;

     

       726
       726
       -
           "valid: with message ids", `Quick, test_with_message_ids;

     

       727
       727
       -
           "edge: empty keywords", `Quick, test_empty_keywords;

     

       728
       728
       -
           "values: minimal", `Quick, test_minimal_values;

     

       729
       729
       -
           "values: full", `Quick, test_full_values;

     

       730
       730
       -
           "values: keywords", `Quick, test_keywords_values;

     

       731
       731
       -
           "values: mailboxIds", `Quick, test_mailbox_ids_values;

     

       732
       732
       -
         ]

     

       733
       733
       -
       end

     

       734
       734
       -
       

     

       735
       735
       -
       (* Thread tests *)

     

       736
       736
       -
       module Thread_tests = struct

     

       737
       737
       -
         open Jmap_mail

     

       738
       738
       -
       

     

       739
       739
       -
         let test_simple () =

     

       740
       740
       -
           test_decode_success "simple" Thread.jsont "mail/thread/valid/simple.json" ()

     

       741
       741
       -
       

     

       742
       742
       -
         let test_conversation () =

     

       743
       743
       -
           test_decode_success "conversation" Thread.jsont "mail/thread/valid/conversation.json" ()

     

       744
       744
       -
       

     

       745
       745
       -
         let test_values () =

     

       746
       746
       -
           let json = read_file "mail/thread/valid/conversation.json" in

     

       747
       747
       -
           match decode Thread.jsont json with

     

       748
       748
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       749
       749
       -
           | Ok thread ->

     

       750
       750
       -
               Alcotest.(check string) "id" "t2" (Jmap_proto.Id.to_string (Thread.id thread));

     

       751
       751
       -
               Alcotest.(check int) "emailIds count" 5 (List.length (Thread.email_ids thread))

     

       752
       752
       -
       

     

       753
       753
       -
         let tests = [

     

       754
       754
       -
           "valid: simple", `Quick, test_simple;

     

       755
       755
       -
           "valid: conversation", `Quick, test_conversation;

     

       756
       756
       -
           "values: conversation", `Quick, test_values;

     

       757
       757
       -
         ]

     

       758
       758
       -
       end

     

       759
       759
       -
       

     

       760
       760
       -
       (* Identity tests *)

     

       761
       761
       -
       module Identity_tests = struct

     

       762
       762
       -
         open Jmap_mail

     

       763
       763
       -
       

     

       764
       764
       -
         let test_simple () =

     

       765
       765
       -
           test_decode_success "simple" Identity.jsont "mail/identity/valid/simple.json" ()

     

       766
       766
       -
       

     

       767
       767
       -
         let test_values () =

     

       768
       768
       -
           let json = read_file "mail/identity/valid/simple.json" in

     

       769
       769
       -
           match decode Identity.jsont json with

     

       770
       770
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       771
       771
       -
           | Ok ident ->

     

       772
       772
       -
               Alcotest.(check string) "name" "Work Identity" (Identity.name ident);

     

       773
       773
       -
               Alcotest.(check string) "email" "john.doe@company.com" (Identity.email ident);

     

       774
       774
       -
               Alcotest.(check bool) "mayDelete" true (Identity.may_delete ident)

     

       775
       775
       -
       

     

       776
       776
       -
         let tests = [

     

       777
       777
       -
           "valid: simple", `Quick, test_simple;

     

       778
       778
       -
           "values: simple", `Quick, test_values;

     

       779
       779
       -
         ]

     

       780
       780
       -
       end

     

       781
       781
       -
       

     

       782
       782
       -
       (* Email address tests *)

     

       783
       783
       -
       module Email_address_tests = struct

     

       784
       784
       -
         open Jmap_mail

     

       785
       785
       -
       

     

       786
       786
       -
         let test_full () =

     

       787
       787
       -
           test_decode_success "full" Email_address.jsont "mail/email_address/valid/full.json" ()

     

       788
       788
       -
       

     

       789
       789
       -
         let test_email_only () =

     

       790
       790
       -
           test_decode_success "email_only" Email_address.jsont "mail/email_address/valid/email_only.json" ()

     

       791
       791
       -
       

     

       792
       792
       -
         let test_full_values () =

     

       793
       793
       -
           let json = read_file "mail/email_address/valid/full.json" in

     

       794
       794
       -
           match decode Email_address.jsont json with

     

       795
       795
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       796
       796
       -
           | Ok addr ->

     

       797
       797
       -
               Alcotest.(check (option string)) "name" (Some "John Doe") (Email_address.name addr);

     

       798
       798
       -
               Alcotest.(check string) "email" "john.doe@example.com" (Email_address.email addr)

     

       799
       799
       -
       

     

       800
       800
       -
         let test_email_only_values () =

     

       801
       801
       -
           let json = read_file "mail/email_address/valid/email_only.json" in

     

       802
       802
       -
           match decode Email_address.jsont json with

     

       803
       803
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       804
       804
       -
           | Ok addr ->

     

       805
       805
       -
               Alcotest.(check (option string)) "name" None (Email_address.name addr);

     

       806
       806
       -
               Alcotest.(check string) "email" "anonymous@example.com" (Email_address.email addr)

     

       807
       807
       -
       

     

       808
       808
       -
         let tests = [

     

       809
       809
       -
           "valid: full", `Quick, test_full;

     

       810
       810
       -
           "valid: email_only", `Quick, test_email_only;

     

       811
       811
       -
           "values: full", `Quick, test_full_values;

     

       812
       812
       -
           "values: email_only", `Quick, test_email_only_values;

     

       813
       813
       -
         ]

     

       814
       814
       -
       end

     

       815
       815
       -
       

     

       816
       816
       -
       (* Vacation tests *)

     

       817
       817
       -
       module Vacation_tests = struct

     

       818
       818
       -
         open Jmap_mail

     

       819
       819
       -
       

     

       820
       820
       -
         let test_enabled () =

     

       821
       821
       -
           test_decode_success "enabled" Vacation.jsont "mail/vacation/valid/enabled.json" ()

     

       822
       822
       -
       

     

       823
       823
       -
         let test_disabled () =

     

       824
       824
       -
           test_decode_success "disabled" Vacation.jsont "mail/vacation/valid/disabled.json" ()

     

       825
       825
       -
       

     

       826
       826
       -
         let test_enabled_values () =

     

       827
       827
       -
           let json = read_file "mail/vacation/valid/enabled.json" in

     

       828
       828
       -
           match decode Vacation.jsont json with

     

       829
       829
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       830
       830
       -
           | Ok vac ->

     

       831
       831
       -
               Alcotest.(check bool) "isEnabled" true (Vacation.is_enabled vac);

     

       832
       832
       -
               Alcotest.(check (option string)) "subject" (Some "Out of Office") (Vacation.subject vac)

     

       833
       833
       -
       

     

       834
       834
       -
         let test_disabled_values () =

     

       835
       835
       -
           let json = read_file "mail/vacation/valid/disabled.json" in

     

       836
       836
       -
           match decode Vacation.jsont json with

     

       837
       837
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       838
       838
       -
           | Ok vac ->

     

       839
       839
       -
               Alcotest.(check bool) "isEnabled" false (Vacation.is_enabled vac);

     

       840
       840
       -
               Alcotest.(check (option string)) "subject" None (Vacation.subject vac)

     

       841
       841
       -
       

     

       842
       842
       -
         let tests = [

     

       843
       843
       -
           "valid: enabled", `Quick, test_enabled;

     

       844
       844
       -
           "valid: disabled", `Quick, test_disabled;

     

       845
       845
       -
           "values: enabled", `Quick, test_enabled_values;

     

       846
       846
       -
           "values: disabled", `Quick, test_disabled_values;

     

       847
       847
       -
         ]

     

       848
       848
       -
       end

     

       849
       849
       -
       

     

       850
       850
       -
       (* Comparator tests *)

     

       851
       851
       -
       module Comparator_tests = struct

     

       852
       852
       -
         open Jmap_proto

     

       853
       853
       -
       

     

       854
       854
       -
         let test_minimal () =

     

       855
       855
       -
           test_decode_success "minimal" Filter.comparator_jsont "filter/valid/comparator_minimal.json" ()

     

       856
       856
       -
       

     

       857
       857
       -
         let test_descending () =

     

       858
       858
       -
           test_decode_success "descending" Filter.comparator_jsont "filter/valid/comparator_descending.json" ()

     

       859
       859
       -
       

     

       860
       860
       -
         let test_with_collation () =

     

       861
       861
       -
           test_decode_success "with collation" Filter.comparator_jsont "filter/valid/comparator_with_collation.json" ()

     

       862
       862
       -
       

     

       863
       863
       -
         let test_minimal_values () =

     

       864
       864
       -
           let json = read_file "filter/valid/comparator_minimal.json" in

     

       865
       865
       -
           match decode Filter.comparator_jsont json with

     

       866
       866
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       867
       867
       -
           | Ok comp ->

     

       868
       868
       -
               Alcotest.(check string) "property" "size" (Filter.comparator_property comp);

     

       869
       869
       -
               Alcotest.(check bool) "isAscending" true (Filter.comparator_is_ascending comp);

     

       870
       870
       -
               Alcotest.(check (option string)) "collation" None (Filter.comparator_collation comp)

     

       871
       871
       -
       

     

       872
       872
       -
         let test_collation_values () =

     

       873
       873
       -
           let json = read_file "filter/valid/comparator_with_collation.json" in

     

       874
       874
       -
           match decode Filter.comparator_jsont json with

     

       875
       875
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       876
       876
       -
           | Ok comp ->

     

       877
       877
       -
               Alcotest.(check string) "property" "subject" (Filter.comparator_property comp);

     

       878
       878
       -
               Alcotest.(check (option string)) "collation" (Some "i;unicode-casemap") (Filter.comparator_collation comp)

     

       879
       879
       -
       

     

       880
       880
       -
         let tests = [

     

       881
       881
       -
           "valid: minimal", `Quick, test_minimal;

     

       882
       882
       -
           "valid: descending", `Quick, test_descending;

     

       883
       883
       -
           "valid: with collation", `Quick, test_with_collation;

     

       884
       884
       -
           "values: minimal", `Quick, test_minimal_values;

     

       885
       885
       -
           "values: with collation", `Quick, test_collation_values;

     

       886
       886
       -
         ]

     

       887
       887
       -
       end

     

       888
       888
       -
       

     

       889
       889
       -
       (* EmailBody tests *)

     

       890
       890
       -
       module EmailBody_tests = struct

     

       891
       891
       -
         open Jmap_mail

     

       892
       892
       -
       

     

       893
       893
       -
         let test_text_part () =

     

       894
       894
       -
           test_decode_success "text part" Email_body.Part.jsont "mail/email_body/valid/text_part.json" ()

     

       895
       895
       -
       

     

       896
       896
       -
         let test_multipart () =

     

       897
       897
       -
           test_decode_success "multipart" Email_body.Part.jsont "mail/email_body/valid/multipart.json" ()

     

       898
       898
       -
       

     

       899
       899
       -
         let test_multipart_mixed () =

     

       900
       900
       -
           test_decode_success "multipart mixed" Email_body.Part.jsont "mail/email_body/valid/multipart_mixed.json" ()

     

       901
       901
       -
       

     

       902
       902
       -
         let test_with_inline_image () =

     

       903
       903
       -
           test_decode_success "with inline image" Email_body.Part.jsont "mail/email_body/valid/with_inline_image.json" ()

     

       904
       904
       -
       

     

       905
       905
       -
         let test_with_language () =

     

       906
       906
       -
           test_decode_success "with language" Email_body.Part.jsont "mail/email_body/valid/with_language.json" ()

     

       907
       907
       -
       

     

       908
       908
       -
         let test_deep_nesting () =

     

       909
       909
       -
           test_decode_success "deep nesting" Email_body.Part.jsont "mail/email_body/edge/deep_nesting.json" ()

     

       910
       910
       -
       

     

       911
       911
       -
         let test_multipart_values () =

     

       912
       912
       -
           let json = read_file "mail/email_body/valid/multipart.json" in

     

       913
       913
       -
           match decode Email_body.Part.jsont json with

     

       914
       914
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       915
       915
       -
           | Ok part ->

     

       916
       916
       -
               Alcotest.(check (option string)) "partId" (Some "0") (Email_body.Part.part_id part);

     

       917
       917
       -
               Alcotest.(check string) "type" "multipart/alternative" (Email_body.Part.type_ part);

     

       918
       918
       -
               match Email_body.Part.sub_parts part with

     

       919
       919
       -
               | None -> Alcotest.fail "expected sub_parts"

     

       920
       920
       -
               | Some subs -> Alcotest.(check int) "sub_parts count" 2 (List.length subs)

     

       921
       921
       -
       

     

       922
       922
       -
         let tests = [

     

       923
       923
       -
           "valid: text part", `Quick, test_text_part;

     

       924
       924
       -
           "valid: multipart", `Quick, test_multipart;

     

       925
       925
       -
           "valid: multipart mixed", `Quick, test_multipart_mixed;

     

       926
       926
       -
           "valid: with inline image", `Quick, test_with_inline_image;

     

       927
       927
       -
           "valid: with language", `Quick, test_with_language;

     

       928
       928
       -
           "edge: deep nesting", `Quick, test_deep_nesting;

     

       929
       929
       -
           "values: multipart", `Quick, test_multipart_values;

     

       930
       930
       -
         ]

     

       931
       931
       -
       end

     

       932
       932
       -
       

     

       933
       933
       -
       (* EmailSubmission tests *)

     

       934
       934
       -
       module EmailSubmission_tests = struct

     

       935
       935
       -
         open Jmap_mail

     

       936
       936
       -
       

     

       937
       937
       -
         let test_simple () =

     

       938
       938
       -
           test_decode_success "simple" Submission.jsont "mail/submission/valid/simple.json" ()

     

       939
       939
       -
       

     

       940
       940
       -
         let test_with_envelope () =

     

       941
       941
       -
           test_decode_success "with envelope" Submission.jsont "mail/submission/valid/with_envelope.json" ()

     

       942
       942
       -
       

     

       943
       943
       -
         let test_final_status () =

     

       944
       944
       -
           test_decode_success "final status" Submission.jsont "mail/submission/valid/final_status.json" ()

     

       945
       945
       -
       

     

       946
       946
       -
         let test_simple_values () =

     

       947
       947
       -
           let json = read_file "mail/submission/valid/simple.json" in

     

       948
       948
       -
           match decode Submission.jsont json with

     

       949
       949
       -
           | Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)

     

       950
       950
       -
           | Ok sub ->

     

       951
       951
       -
               Alcotest.(check string) "id" "sub1" (Jmap_proto.Id.to_string (Submission.id sub));

     

       952
       952
       -
               (* Check undoStatus is Pending *)

     

       953
       953
       -
               match Submission.undo_status sub with

     

       954
       954
       -
               | Submission.Pending -> ()

     

       955
       955
       -
               | _ -> Alcotest.fail "expected undoStatus to be pending"

     

       956
       956
       -
       

     

       957
       957
       -
         let tests = [

     

       958
       958
       -
           "valid: simple", `Quick, test_simple;

     

       959
       959
       -
           "valid: with envelope", `Quick, test_with_envelope;

     

       960
       960
       -
           "valid: final status", `Quick, test_final_status;

     

       961
       961
       -
           "values: simple", `Quick, test_simple_values;

     

       962
       962
       -
         ]

     

       963
       963
       -
       end

     

       964
       964
       -
       

     

       965
       965
       -
       (* Run all tests *)

     

       966
       966
       -
       let () =

     

       967
       967
       -
         Alcotest.run "JMAP Proto Codecs" [

     

       968
       968
       -
           "Id", Id_tests.tests;

     

       969
       969
       -
           "Int53", Int53_tests.tests;

     

       970
       970
       -
           "Date", Date_tests.tests;

     

       971
       971
       -
           "Session", Session_tests.tests;

     

       972
       972
       -
           "Request", Request_tests.tests;

     

       973
       973
       -
           "Response", Response_tests.tests;

     

       974
       974
       -
           "Invocation", Invocation_tests.tests;

     

       975
       975
       -
           "Capability", Capability_tests.tests;

     

       976
       976
       -
           "Method", Method_tests.tests;

     

       977
       977
       -
           "Error", Error_tests.tests;

     

       978
       978
       -
           "Comparator", Comparator_tests.tests;

     

       979
       979
       -
           "Mailbox", Mailbox_tests.tests;

     

       980
       980
       -
           "Email", Email_tests.tests;

     

       981
       981
       -
           "EmailBody", EmailBody_tests.tests;

     

       982
       982
       -
           "Thread", Thread_tests.tests;

     

       983
       983
       -
           "Identity", Identity_tests.tests;

     

       984
       984
       -
           "Email_address", Email_address_tests.tests;

     

       985
       985
       -
           "EmailSubmission", EmailSubmission_tests.tests;

     

       986
       986
       -
           "Vacation", Vacation_tests.tests;

     

       987
       987
       -
         ]

Compare changes