comparing 1488ce2d120f2ab07ca668bd63836ad68a8b81be and main on anil.recoil.org/ocaml-jmap

-73

AGENT.md

···

       1
       1
       -
       # Guidelines for the AI copilot editor.

     

       2
       2
       -
       

     

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

     

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

     

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

     

       6
       6
       -
       

     

       7
       7
       -
       ## Project structure

     

       8
       8
       -
       

     

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

     

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

     

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

     

       12
       12
       -
       

     

       13
       13
       -
       ## Coding Instructions

     

       14
       14
       -
       

     

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

     

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

     

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

     

       18
       18
       -
       work.

     

       19
       19
       -
       

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       37
       37
       -
          subjects and sender details to stdout.

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       46
       46
       -
          JMAP labels defined in there.

     

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

     

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

     

       49
       49
       -
          single request, from reading the specs.

     

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

     

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

     

       52
       52
       -
           this logic into the Jmap_mail library.

     

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

     

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

     

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

     

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

     

       57
       57
       -
           version of the RFCs stored in specs/

     

       58
       58
       -
       14. DONE Add an ocamldoc-format tutorial on how to use the library to index.mld along with cross references

     

       59
       59
       -
           into the various libraries. Put corresponding executable files into bin/ so that they can be

     

       60
       60
       -
           build tested and run as well. Assume the pattern of the JMAP_API_TOKEN environment variable being

     

       61
       61
       -
           set can be counted on to be present when they are run.

     

       62
       62
       -
       15. DONE Add a README.md to this repository that describes what this is. Note explicitly in the

     

       63
       63
       -
           README that this is largely an AI-generated interface and has not been audited carefully.

     

       64
       64
       -
       16. DONE Ensure examples use the proper higher-level API functions from the library instead of

     

       65
       65
       -
           manually constructing low-level requests. Particularly, the fastmail_list binary should

     

       66
       66
       -
           demonstrate the recommended way to use the library with Jmap_mail's API.

     

       67
       67
       -
       17. DONE Add helper functions to Jmap.Api such as `string_of_error` and `pp_error` to format

     

       68
       68
       -
           errors consistently. Updated the fastmail_list binary to use these functions instead of

     

       69
       69
       -
           duplicating error handling code.

     

       70
       70
       -
       18. DONE Add support for JMAP email submission to the library, and create a fastmail-send that accepts

     

       71
       71
       -
           a list of to: on the CLI as arguments and a subject on the CLI and reads in the message body

     

       72
       72
       -
       19. DONE Port fastmail-list to use Cmdliner instead of Arg with nice manual page.

     

       73
       73
       -
       20. Make JMAP_TOKEN_API handling a Cmdliner term as well so it can be reused.

-71

README.md

···

       1
       1
       -
       # JMAP OCaml Client

     

       2
       2
       -
       

     

       3
       3
       -
       An OCaml interface to the JMAP protocol ([RFC8620](https://datatracker.ietf.org/doc/html/rfc8620)) and JMAP Mail extension ([RFC8621](https://datatracker.ietf.org/doc/html/rfc8621)).

     

       4
       4
       -
       

     

       5
       5
       -
       **Note:** This library is largely AI-generated and has not been audited carefully. It's a proof-of-concept implementation of the JMAP specification.

     

       6
       6
       -
       

     

       7
       7
       -
       ## Overview

     

       8
       8
       -
       

     

       9
       9
       -
       JMAP (JSON Meta Application Protocol) is a modern protocol for synchronizing email, calendars, and contacts designed as a replacement for legacy protocols like IMAP. This OCaml implementation provides:

     

       10
       10
       -
       

     

       11
       11
       -
       - Type-safe OCaml interfaces to the JMAP Core and Mail specifications

     

       12
       12
       -
       - Authentication with username/password or API tokens (Fastmail support)

     

       13
       13
       -
       - Convenient functions for common email and mailbox operations

     

       14
       14
       -
       - Support for composing complex multi-part requests with result references

     

       15
       15
       -
       - Typed handling of message flags, keywords, and mailbox attributes

     

       16
       16
       -
       

     

       17
       17
       -
       ## Installation

     

       18
       18
       -
       

     

       19
       19
       -
       Add to your project with opam:

     

       20
       20
       -
       

     

       21
       21
       -
       ```

     

       22
       22
       -
       opam install .

     

       23
       23
       -
       ```

     

       24
       24
       -
       

     

       25
       25
       -
       ## Features

     

       26
       26
       -
       

     

       27
       27
       -
       - **Core JMAP Protocol**

     

       28
       28
       -
         - Session handling

     

       29
       29
       -
         - API request/response management

     

       30
       30
       -
         - Type-safe representation of all JMAP structures

     

       31
       31
       -
         - Result references for composing multi-step requests

     

       32
       32
       -
       

     

       33
       33
       -
       - **JMAP Mail Extension**

     

       34
       34
       -
         - Mailbox operations (folders/labels)

     

       35
       35
       -
         - Email retrieval and manipulation

     

       36
       36
       -
         - Thread handling

     

       37
       37
       -
         - Identity management

     

       38
       38
       -
         - Email submission

     

       39
       39
       -
         - Message flags and keywords

     

       40
       40
       -
       

     

       41
       41
       -
       - **Fastmail Integration**

     

       42
       42
       -
         - API token authentication

     

       43
       43
       -
         - Example tools for listing messages

     

       44
       44
       -
       

     

       45
       45
       -
       ## Documentation

     

       46
       46
       -
       

     

       47
       47
       -
       The library includes comprehensive OCamldoc documentation with cross-references to the relevant sections of the JMAP specifications.

     

       48
       48
       -
       

     

       49
       49
       -
       Build the documentation with:

     

       50
       50
       -
       

     

       51
       51
       -
       ```

     

       52
       52
       -
       dune build @doc

     

       53
       53
       -
       ```

     

       54
       54
       -
       

     

       55
       55
       -
       ## Example Tools

     

       56
       56
       -
       

     

       57
       57
       -
       The package includes several example tools:

     

       58
       58
       -
       

     

       59
       59
       -
       - `fastmail-list`: Lists emails from a Fastmail account (requires JMAP_API_TOKEN)

     

       60
       60
       -
       - `jmap-tutorial-examples`: Demonstrates basic JMAP operations as shown in the tutorial

     

       61
       61
       -
       

     

       62
       62
       -
       ## License

     

       63
       63
       -
       

     

       64
       64
       -
       [MIT License](LICENSE)

     

       65
       65
       -
       

     

       66
       66
       -
       ## References

     

       67
       67
       -
       

     

       68
       68
       -
       - [RFC8620: The JSON Meta Application Protocol (JMAP)](https://datatracker.ietf.org/doc/html/rfc8620)

     

       69
       69
       -
       - [RFC8621: The JSON Meta Application Protocol (JMAP) for Mail](https://datatracker.ietf.org/doc/html/rfc8621)

     

       70
       70
       -
       - [Message Flag and Mailbox Attribute Extension](https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute-02)

     

       71
       71
       -
       - [Fastmail Developer Documentation](https://www.fastmail.com/dev/)

+4 -26

bin/dune

···

       1
       1
        
       (executable

     

       2
       2
       -
        (name fastmail_list)

     

       3
       3
       -
        (public_name fastmail-list)

     

       4
       4
       -
        (package jmap)

     

       5
       5
       -
        (modules fastmail_list)

     

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

     

       7
       7
       -
       

     

       8
       8
       -
       (executable

     

       9
       9
       -
        (name flag_color_test)

     

       10
       10
       -
        (public_name flag-color-test)

     

       11
       11
       -
        (package jmap)

     

       12
       12
       -
        (modules flag_color_test)

     

       13
       13
       -
        (libraries jmap jmap_mail))

     

       14
       14
       -
       

     

       15
       15
       -
       (executable

     

       16
       16
       -
        (name tutorial_examples)

     

       17
       17
       -
        (public_name jmap-tutorial-examples)

     

       18
       18
       -
        (package jmap)

     

       19
       19
       -
        (modules tutorial_examples)

     

       20
       20
       -
        (libraries jmap jmap_mail))

     

       21
       21
       -
       

     

       22
       22
       -
       (executable

     

       23
       23
       -
        (name fastmail_send)

     

       24
       24
       -
        (public_name fastmail-send)

     

       25
       25
       -
        (package jmap)

     

       26
       26
       -
        (modules fastmail_send)

     

       27
       27
       -
        (libraries jmap jmap_mail lwt.unix cmdliner fmt))

     

       2
       2
       +
        (name jmap_test)

     

       3
       3
       +
        (public_name jmap-test)

     

       4
       4
       +
        (package jmap-eio)

     

       5
       5
       +
        (libraries jmap-eio eio_main))

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

-3

dune

···

       1
       1
       -
       (documentation

     

       2
       2
       -
        (package jmap)

     

       3
       3
       -
         (mld_files index))

+28 -14

dune-project

···

       1
       1
       -
       (lang dune 3.17)

     

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
        
       

     

       3
       3
        
       (name jmap)

     

       4
       4
        
       

     

       5
       5
       -
       (source (github avsm/jmap))

     

       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
       +
       

     

       6
       14
        
       (license ISC)

     

       7
       7
       -
       (authors "Anil Madhavapeddy")

     

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

     

       9
       15
        
       

     

       10
       10
       -
       (generate_opam_files true)

     

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

     

       11
       17
        
       

     

       12
       18
        
       (package

     

       13
       19
        
        (name jmap)

     

       14
       14
       -
        (synopsis "JMAP protocol")

     

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

     

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

     

       16
       23
        
        (depends

     

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

     

       18
       18
       -
         ptime

     

       19
       19
       -
         cohttp

     

       20
       20
       -
         cohttp-lwt-unix

     

       21
       21
       -
         ezjsonm

     

       22
       22
       -
         uri

     

       23
       23
       -
         lwt))

     

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

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

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

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

-360

index.mld

···

       1
       1
       -
       {0 JMAP OCaml Client}

     

       2
       2
       -
       

     

       3
       3
       -
       This library provides a type-safe OCaml interface to the JMAP protocol (RFC8620) and JMAP Mail extension (RFC8621).

     

       4
       4
       -
       

     

       5
       5
       -
       {1 Overview}

     

       6
       6
       -
       

     

       7
       7
       -
       JMAP (JSON Meta Application Protocol) is a modern protocol for synchronizing email, calendars, and contacts designed as a replacement for legacy protocols like IMAP. This OCaml implementation provides:

     

       8
       8
       -
       

     

       9
       9
       -
       - Type-safe OCaml interfaces to the JMAP Core and Mail specifications

     

       10
       10
       -
       - Authentication with username/password or API tokens (Fastmail support)

     

       11
       11
       -
       - Convenient functions for common email and mailbox operations

     

       12
       12
       -
       - Support for composing complex multi-part requests with result references

     

       13
       13
       -
       - Typed handling of message flags, keywords, and mailbox attributes

     

       14
       14
       -
       

     

       15
       15
       -
       {1 Getting Started}

     

       16
       16
       -
       

     

       17
       17
       -
       {2 Core Modules}

     

       18
       18
       -
       

     

       19
       19
       -
       The library is organized into two main packages:

     

       20
       20
       -
       

     

       21
       21
       -
       - {!module:Jmap} - Core protocol functionality (RFC8620)

     

       22
       22
       -
       - {!module:Jmap_mail} - Mail-specific extensions (RFC8621)

     

       23
       23
       -
       

     

       24
       24
       -
       {2 Authentication}

     

       25
       25
       -
       

     

       26
       26
       -
       To begin working with JMAP, you first need to establish a session:

     

       27
       27
       -
       

     

       28
       28
       -
       {[

     

       29
       29
       -
       (* Using username/password *)

     

       30
       30
       -
       let result = Jmap_mail.login 

     

       31
       31
       -
         ~uri:"https://jmap.example.com/jmap/session" 

     

       32
       32
       -
         ~credentials:{

     

       33
       33
       -
           username = "user@example.com";

     

       34
       34
       -
           password = "password";

     

       35
       35
       -
         }

     

       36
       36
       -
       

     

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

     

       38
       38
       -
       let token = Sys.getenv "JMAP_API_TOKEN" in

     

       39
       39
       -
       let result = Jmap_mail.login_with_token

     

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

     

       41
       41
       -
         ~api_token:token

     

       42
       42
       -
         ()

     

       43
       43
       -
       

     

       44
       44
       -
       (* Handle the result *)

     

       45
       45
       -
       match result with

     

       46
       46
       -
       | Ok conn -> 

     

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

     

       48
       48
       -
           let account_id =

     

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

     

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

     

       51
       51
       -
             | Some id -> id

     

       52
       52
       -
             | None -> (* Use first account or handle error *)

     

       53
       53
       -
           in

     

       54
       54
       -
           (* Use connection and account_id for further operations *)

     

       55
       55
       -
       | Error e -> (* Handle error *)

     

       56
       56
       -
       ]}

     

       57
       57
       -
       

     

       58
       58
       -
       {2 Working with Mailboxes}

     

       59
       59
       -
       

     

       60
       60
       -
       Once authenticated, you can retrieve and manipulate mailboxes:

     

       61
       61
       -
       

     

       62
       62
       -
       {[

     

       63
       63
       -
       (* Get all mailboxes *)

     

       64
       64
       -
       let get_mailboxes conn account_id =

     

       65
       65
       -
         Jmap_mail.get_mailboxes conn ~account_id

     

       66
       66
       -
       

     

       67
       67
       -
       (* Find inbox by role *)

     

       68
       68
       -
       let find_inbox mailboxes =

     

       69
       69
       -
         List.find_opt

     

       70
       70
       -
           (fun m -> m.Jmap_mail.Types.role = Some Jmap_mail.Types.Inbox)

     

       71
       71
       -
           mailboxes

     

       72
       72
       -
       ]}

     

       73
       73
       -
       

     

       74
       74
       -
       {2 Working with Emails}

     

       75
       75
       -
       

     

       76
       76
       -
       Retrieve and filter emails:

     

       77
       77
       -
       

     

       78
       78
       -
       {[

     

       79
       79
       -
       (* Get emails from a mailbox *)

     

       80
       80
       -
       let get_emails conn account_id mailbox_id =

     

       81
       81
       -
         Jmap_mail.get_messages_in_mailbox

     

       82
       82
       -
           conn

     

       83
       83
       -
           ~account_id

     

       84
       84
       -
           ~mailbox_id

     

       85
       85
       -
           ~limit:100

     

       86
       86
       -
           ()

     

       87
       87
       -
       

     

       88
       88
       -
       (* Get only unread emails *)

     

       89
       89
       -
       let is_unread email =

     

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

     

       91
       91
       -
           (kw = Jmap_mail.Types.Unread || 

     

       92
       92
       -
            kw = Jmap_mail.Types.Custom "$unread") && active

     

       93
       93
       -
         ) email.Jmap_mail.Types.keywords

     

       94
       94
       -
       

     

       95
       95
       -
       let get_unread_emails conn account_id mailbox_id =

     

       96
       96
       -
         let* result = get_emails conn account_id mailbox_id in

     

       97
       97
       -
         match result with

     

       98
       98
       -
         | Ok emails -> Lwt.return_ok (List.filter is_unread emails)

     

       99
       99
       -
         | Error e -> Lwt.return_error e

     

       100
       100
       -
       

     

       101
       101
       -
       (* Filter by sender email *)

     

       102
       102
       -
       let filter_by_sender emails sender_pattern =

     

       103
       103
       -
         List.filter (fun email -> 

     

       104
       104
       -
           Jmap_mail.email_matches_sender email sender_pattern

     

       105
       105
       -
         ) emails

     

       106
       106
       -
       ]}

     

       107
       107
       -
       

     

       108
       108
       -
       {2 Message Flags and Keywords}

     

       109
       109
       -
       

     

       110
       110
       -
       Work with email flags and keywords:

     

       111
       111
       -
       

     

       112
       112
       -
       {[

     

       113
       113
       -
       (* Check if an email has a specific keyword *)

     

       114
       114
       -
       let has_keyword keyword email =

     

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

     

       116
       116
       -
           match kw, active with

     

       117
       117
       -
           | Jmap_mail.Types.Custom k, true when k = keyword -> true

     

       118
       118
       -
           | _ -> false

     

       119
       119
       -
         ) email.Jmap_mail.Types.keywords

     

       120
       120
       -
       

     

       121
       121
       -
       (* Add a keyword to an email *)

     

       122
       122
       -
       let add_keyword conn account_id email_id keyword =

     

       123
       123
       -
         (* This would typically involve creating an Email/set request

     

       124
       124
       -
            that updates the keywords property of the email *)

     

       125
       125
       -
         failwith "Not fully implemented in this example"

     

       126
       126
       -
       

     

       127
       127
       -
       (* Get flag color *)

     

       128
       128
       -
       let get_flag_color email =

     

       129
       129
       -
         Jmap_mail.Types.get_flag_color email.Jmap_mail.Types.keywords

     

       130
       130
       -
       

     

       131
       131
       -
       (* Set flag color *)

     

       132
       132
       -
       let set_flag_color conn account_id email_id color =

     

       133
       133
       -
         Jmap_mail.Types.set_flag_color conn account_id email_id color

     

       134
       134
       -
       ]}

     

       135
       135
       -
       

     

       136
       136
       -
       {2 Composing Requests with Result References}

     

       137
       137
       -
       

     

       138
       138
       -
       JMAP allows composing multiple operations into a single request:

     

       139
       139
       -
       

     

       140
       140
       -
       {[

     

       141
       141
       -
       (* Example demonstrating result references for chained requests *)

     

       142
       142
       -
       let demo_result_references conn account_id =

     

       143
       143
       -
         let open Jmap.Types in

     

       144
       144
       -
         

     

       145
       145
       -
         (* Create method call IDs *)

     

       146
       146
       -
         let mailbox_get_id = "mailboxGet" in

     

       147
       147
       -
         let email_query_id = "emailQuery" in

     

       148
       148
       -
         let email_get_id = "emailGet" in

     

       149
       149
       -
         

     

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

     

       151
       151
       -
         let mailbox_get_call = {

     

       152
       152
       -
           name = "Mailbox/get";

     

       153
       153
       -
           arguments = `O [

     

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

     

       155
       155
       -
           ];

     

       156
       156
       -
           method_call_id = mailbox_get_id;

     

       157
       157
       -
         } in

     

       158
       158
       -
         

     

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

     

       160
       160
       -
         let mailbox_id_ref = Jmap.ResultReference.create

     

       161
       161
       -
           ~result_of:mailbox_get_id

     

       162
       162
       -
           ~name:"Mailbox/get"

     

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

     

       164
       164
       -
         

     

       165
       165
       -
         let (mailbox_id_ref_key, mailbox_id_ref_value) = 

     

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

     

       167
       167
       -
         

     

       168
       168
       -
         let email_query_call = {

     

       169
       169
       -
           name = "Email/query";

     

       170
       170
       -
           arguments = `O [

     

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

     

       172
       172
       -
             ("filter", `O [

     

       173
       173
       -
               (mailbox_id_ref_key, mailbox_id_ref_value)

     

       174
       174
       -
             ]);

     

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

     

       176
       176
       -
           ];

     

       177
       177
       -
           method_call_id = email_query_id;

     

       178
       178
       -
         } in

     

       179
       179
       -
         

     

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

     

       181
       181
       -
         let email_ids_ref = Jmap.ResultReference.create

     

       182
       182
       -
           ~result_of:email_query_id

     

       183
       183
       -
           ~name:"Email/query"

     

       184
       184
       -
           ~path:"/ids" in

     

       185
       185
       -
         

     

       186
       186
       -
         let (email_ids_ref_key, email_ids_ref_value) = 

     

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

     

       188
       188
       -
         

     

       189
       189
       -
         let email_get_call = {

     

       190
       190
       -
           name = "Email/get";

     

       191
       191
       -
           arguments = `O [

     

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

     

       193
       193
       -
             (email_ids_ref_key, email_ids_ref_value)

     

       194
       194
       -
           ];

     

       195
       195
       -
           method_call_id = email_get_id;

     

       196
       196
       -
         } in

     

       197
       197
       -
         

     

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

     

       199
       199
       -
         let request = {

     

       200
       200
       -
           using = [

     

       201
       201
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       202
       202
       -
             Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail

     

       203
       203
       -
           ];

     

       204
       204
       -
           method_calls = [

     

       205
       205
       -
             mailbox_get_call;

     

       206
       206
       -
             email_query_call;

     

       207
       207
       -
             email_get_call

     

       208
       208
       -
           ];

     

       209
       209
       -
           created_ids = None;

     

       210
       210
       -
         } in

     

       211
       211
       -
         

     

       212
       212
       -
         (* Execute the request *)

     

       213
       213
       -
         Jmap.Api.make_request conn.config request

     

       214
       214
       -
       ]}

     

       215
       215
       -
       

     

       216
       216
       -
       {1 Example: List Recent Emails}

     

       217
       217
       -
       

     

       218
       218
       -
       Here's a complete example showing how to list recent emails from a mailbox:

     

       219
       219
       -
       

     

       220
       220
       -
       {[

     

       221
       221
       -
       open Lwt.Syntax

     

       222
       222
       -
       open Jmap

     

       223
       223
       -
       open Jmap_mail

     

       224
       224
       -
       

     

       225
       225
       -
       (* Main function that demonstrates JMAP functionality *)

     

       226
       226
       -
       let main () =

     

       227
       227
       -
         (* Initialize logging *)

     

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

     

       229
       229
       -
         

     

       230
       230
       -
         (* Check for API token *)

     

       231
       231
       -
         match Sys.getenv_opt "JMAP_API_TOKEN" with

     

       232
       232
       -
         | None ->

     

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

     

       234
       234
       -
             Lwt.return 1

     

       235
       235
       -
         | Some token ->

     

       236
       236
       -
             (* Authentication example *)

     

       237
       237
       -
             let* login_result = Jmap_mail.login_with_token 

     

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

     

       239
       239
       -
               ~api_token:token

     

       240
       240
       -
             in

     

       241
       241
       -
             

     

       242
       242
       -
             match login_result with

     

       243
       243
       -
             | Error err ->

     

       244
       244
       -
                 Printf.eprintf "Authentication failed\n";

     

       245
       245
       -
                 Lwt.return 1

     

       246
       246
       -
                 

     

       247
       247
       -
             | Ok conn ->

     

       248
       248
       -
                 (* Get primary account ID *)

     

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

     

       250
       250
       -
                 let account_id = 

     

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

     

       252
       252
       -
                   | Some id -> id

     

       253
       253
       -
                   | None -> 

     

       254
       254
       -
                       match conn.session.accounts with

     

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

     

       256
       256
       -
                       | [] -> 

     

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

     

       258
       258
       -
                           exit 1

     

       259
       259
       -
                 in

     

       260
       260
       -
                 

     

       261
       261
       -
                 (* Get mailboxes example *)

     

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

     

       263
       263
       -
                 

     

       264
       264
       -
                 match mailboxes_result with

     

       265
       265
       -
                 | Error err ->

     

       266
       266
       -
                     Printf.eprintf "Failed to get mailboxes\n";

     

       267
       267
       -
                     Lwt.return 1

     

       268
       268
       -
                     

     

       269
       269
       -
                 | Ok mailboxes ->

     

       270
       270
       -
                     (* Use the first mailbox for simplicity *)

     

       271
       271
       -
                     match mailboxes with

     

       272
       272
       -
                     | [] ->

     

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

     

       274
       274
       -
                         Lwt.return 1

     

       275
       275
       -
                         

     

       276
       276
       -
                     | first_mailbox :: _ ->

     

       277
       277
       -
                         (* Get emails example *)

     

       278
       278
       -
                         let* emails_result = Jmap_mail.get_messages_in_mailbox

     

       279
       279
       -
                           conn

     

       280
       280
       -
                           ~account_id

     

       281
       281
       -
                           ~mailbox_id:first_mailbox.Types.id

     

       282
       282
       -
                           ~limit:5

     

       283
       283
       -
                           ()

     

       284
       284
       -
                         in

     

       285
       285
       -
                         

     

       286
       286
       -
                         match emails_result with

     

       287
       287
       -
                         | Error err ->

     

       288
       288
       -
                             Printf.eprintf "Failed to get emails\n";

     

       289
       289
       -
                             Lwt.return 1

     

       290
       290
       -
                             

     

       291
       291
       -
                         | Ok emails ->

     

       292
       292
       -
                             (* Display emails *)

     

       293
       293
       -
                             List.iter (fun email ->

     

       294
       294
       -
                               let module Mail = Jmap_mail.Types in

     

       295
       295
       -
                               

     

       296
       296
       -
                               (* Get sender *)

     

       297
       297
       -
                               let sender = match email.Mail.from with

     

       298
       298
       -
                                 | None -> "<unknown>"

     

       299
       299
       -
                                 | Some addrs -> 

     

       300
       300
       -
                                     match addrs with

     

       301
       301
       -
                                     | [] -> "<unknown>"

     

       302
       302
       -
                                     | addr :: _ ->

     

       303
       303
       -
                                         match addr.Mail.name with

     

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

     

       305
       305
       -
                                         | Some name -> 

     

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

     

       307
       307
       -
                               in

     

       308
       308
       -
                               

     

       309
       309
       -
                               (* Get subject *)

     

       310
       310
       -
                               let subject = match email.Mail.subject with

     

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

     

       312
       312
       -
                                 | Some s -> s

     

       313
       313
       -
                               in

     

       314
       314
       -
                               

     

       315
       315
       -
                               (* Is unread? *)

     

       316
       316
       -
                               let is_unread = List.exists (fun (kw, active) -> 

     

       317
       317
       -
                                 match kw with

     

       318
       318
       -
                                 | Mail.Unread -> active

     

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

     

       320
       320
       -
                                 | _ -> false

     

       321
       321
       -
                               ) email.Mail.keywords in

     

       322
       322
       -
                               

     

       323
       323
       -
                               (* Print email info *)

     

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

     

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

     

       326
       326
       -
                                 sender

     

       327
       327
       -
                                 subject

     

       328
       328
       -
                             ) emails;

     

       329
       329
       -
                             

     

       330
       330
       -
                             Lwt.return 0

     

       331
       331
       -
       

     

       332
       332
       -
       (* Program entry point *)

     

       333
       333
       -
       let () =

     

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

     

       335
       335
       -
         exit exit_code

     

       336
       336
       -
       ]}

     

       337
       337
       -
       

     

       338
       338
       -
       {1 API Reference}

     

       339
       339
       -
       

     

       340
       340
       -
       {2 Core Modules}

     

       341
       341
       -
       

     

       342
       342
       -
       - {!module:Jmap} - Core JMAP protocol

     

       343
       343
       -
         - {!module:Jmap.Types} - Core type definitions

     

       344
       344
       -
         - {!module:Jmap.Api} - HTTP client and session handling

     

       345
       345
       -
         - {!module:Jmap.ResultReference} - Request composition utilities

     

       346
       346
       -
         - {!module:Jmap.Capability} - JMAP capability handling

     

       347
       347
       -
       

     

       348
       348
       -
       {2 Mail Extension Modules}

     

       349
       349
       -
       

     

       350
       350
       -
       - {!module:Jmap_mail} - JMAP Mail extension

     

       351
       351
       -
         - {!module:Jmap_mail.Types} - Mail-specific types

     

       352
       352
       -
         - Jmap_mail.Capability - Mail capability handling

     

       353
       353
       -
         - Jmap_mail.Json - JSON serialization 

     

       354
       354
       -
         - Specialized operations for emails, mailboxes, threads, and identities

     

       355
       355
       -
       

     

       356
       356
       -
       {1 References}

     

       357
       357
       -
       

     

       358
       358
       -
       - {{:https://datatracker.ietf.org/doc/html/rfc8620}} RFC8620: The JSON Meta Application Protocol (JMAP)

     

       359
       359
       -
       - {{:https://datatracker.ietf.org/doc/html/rfc8621}} RFC8621: The JSON Meta Application Protocol (JMAP) for Mail

     

       360
       360
       -
       - {{:https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute-02}} Message Flag and Mailbox Attribute Extension

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

+13 -15

jmap.opam

···

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

     

       2
       2
        
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "JMAP protocol"

     

       4
       4
       -
       description: "This is all still a work in progress"

     

       5
       5
       -
       maintainer: ["anil@recoil.org"]

     

       6
       6
       -
       authors: ["Anil Madhavapeddy"]

     

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

     

       7
       8
        
       license: "ISC"

     

       8
       8
       -
       homepage: "https://github.com/avsm/jmap"

     

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

     

       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"

     

       10
       12
        
       depends: [

     

       11
       11
       -
         "dune" {>= "3.17"}

     

       12
       12
       -
         "ocaml" {>= "5.2.0"}

     

       13
       13
       -
         "ptime"

     

       14
       14
       -
         "cohttp"

     

       15
       15
       -
         "cohttp-lwt-unix"

     

       16
       16
       -
         "ezjsonm"

     

       17
       17
       -
         "uri"

     

       18
       18
       -
         "lwt"

     

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

     

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

     

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

     

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

     

       19
       17
        
         "odoc" {with-doc}

     

       20
       18
        
       ]

     

       21
       19
        
       build: [

     
···

       32
       30
        
           "@doc" {with-doc}

     

       33
       31
        
         ]

     

       34
       32
        
       ]

     

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

     

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

-11

lib/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name jmap)

     

       3
       3
       -
        (public_name jmap)

     

       4
       4
       -
        (modules jmap)

     

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

     

       6
       6
       -
       

     

       7
       7
       -
       (library

     

       8
       8
       -
        (name jmap_mail)

     

       9
       9
       -
        (public_name jmap.mail)

     

       10
       10
       -
        (modules jmap_mail)

     

       11
       11
       -
        (libraries jmap))

-804

lib/jmap.ml

···

       1
       1
       -
       (**

     

       2
       2
       -
        * JMAP protocol implementation based on RFC8620

     

       3
       3
       -
        * https://datatracker.ietf.org/doc/html/rfc8620

     

       4
       4
       -
        *)

     

       5
       5
       -
       

     

       6
       6
       -
       (** Whether to redact sensitive information *)

     

       7
       7
       -
       let should_redact_sensitive = ref true

     

       8
       8
       -
       

     

       9
       9
       -
       (** Initialize and configure logging for JMAP *)

     

       10
       10
       -
       let init_logging ?(level=2) ?(enable_logs=true) ?(redact_sensitive=true) () =

     

       11
       11
       -
         if enable_logs then begin

     

       12
       12
       -
           Logs.set_reporter (Logs.format_reporter ());

     

       13
       13
       -
           match level with

     

       14
       14
       -
           | 0 -> Logs.set_level None

     

       15
       15
       -
           | 1 -> Logs.set_level (Some Logs.Error)

     

       16
       16
       -
           | 2 -> Logs.set_level (Some Logs.Info)

     

       17
       17
       -
           | 3 -> Logs.set_level (Some Logs.Debug)

     

       18
       18
       -
           | _ -> Logs.set_level (Some Logs.Debug)

     

       19
       19
       -
         end else

     

       20
       20
       -
           Logs.set_level None;

     

       21
       21
       -
         should_redact_sensitive := redact_sensitive

     

       22
       22
       -
       

     

       23
       23
       -
       (** Redact sensitive data like tokens *)

     

       24
       24
       -
       let redact_token ?(redact=true) token =

     

       25
       25
       -
         if redact && !should_redact_sensitive && String.length token > 8 then

     

       26
       26
       -
           let prefix = String.sub token 0 4 in

     

       27
       27
       -
           let suffix = String.sub token (String.length token - 4) 4 in

     

       28
       28
       -
           prefix ^ "..." ^ suffix

     

       29
       29
       -
         else

     

       30
       30
       -
           token

     

       31
       31
       -
       

     

       32
       32
       -
       (** Redact sensitive headers like Authorization *)

     

       33
       33
       -
       let redact_headers headers =

     

       34
       34
       -
         List.map (fun (k, v) ->

     

       35
       35
       -
           if String.lowercase_ascii k = "authorization" then

     

       36
       36
       -
             if !should_redact_sensitive then

     

       37
       37
       -
               let parts = String.split_on_char ' ' v in

     

       38
       38
       -
               match parts with

     

       39
       39
       -
               | scheme :: token :: _ -> (k, scheme ^ " " ^ redact_token token)

     

       40
       40
       -
               | _ -> (k, v)

     

       41
       41
       -
             else (k, v)

     

       42
       42
       -
           else (k, v)

     

       43
       43
       -
         ) headers

     

       44
       44
       -
       

     

       45
       45
       -
       (* Initialize logging with defaults *)

     

       46
       46
       -
       let () = init_logging ()

     

       47
       47
       -
       

     

       48
       48
       -
       (** Module for managing JMAP capability URIs and other constants *)

     

       49
       49
       -
       module Capability = struct

     

       50
       50
       -
         (** JMAP capability URI as specified in RFC8620 *)

     

       51
       51
       -
         let core_uri = "urn:ietf:params:jmap:core"

     

       52
       52
       -
       

     

       53
       53
       -
         (** All JMAP capability types *)

     

       54
       54
       -
         type t = 

     

       55
       55
       -
           | Core       (** Core JMAP capability *)

     

       56
       56
       -
           | Extension of string  (** Extension capabilities *)

     

       57
       57
       -
       

     

       58
       58
       -
         (** Convert capability to URI string *)

     

       59
       59
       -
         let to_string = function

     

       60
       60
       -
           | Core -> core_uri

     

       61
       61
       -
           | Extension s -> s

     

       62
       62
       -
       

     

       63
       63
       -
         (** Parse a string to a capability, returns Extension for non-core capabilities *)

     

       64
       64
       -
         let of_string s =

     

       65
       65
       -
           if s = core_uri then Core

     

       66
       66
       -
           else Extension s

     

       67
       67
       -
           

     

       68
       68
       -
         (** Check if a capability matches a core capability *)

     

       69
       69
       -
         let is_core = function

     

       70
       70
       -
           | Core -> true

     

       71
       71
       -
           | Extension _ -> false

     

       72
       72
       -
       

     

       73
       73
       -
         (** Check if a capability string is a core capability *)

     

       74
       74
       -
         let is_core_string s = s = core_uri

     

       75
       75
       -
       

     

       76
       76
       -
         (** Create a list of capability strings *)

     

       77
       77
       -
         let strings_of_capabilities capabilities =

     

       78
       78
       -
           List.map to_string capabilities

     

       79
       79
       -
       end

     

       80
       80
       -
       

     

       81
       81
       -
       module Types = struct

     

       82
       82
       -
         (** Id string as per Section 1.2 *)

     

       83
       83
       -
         type id = string

     

       84
       84
       -
       

     

       85
       85
       -
         (** Int bounded within the range -2^53+1 to 2^53-1 as per Section 1.3 *)

     

       86
       86
       -
         type int_t = int

     

       87
       87
       -
       

     

       88
       88
       -
         (** UnsignedInt bounded within the range 0 to 2^53-1 as per Section 1.3 *)

     

       89
       89
       -
         type unsigned_int = int

     

       90
       90
       -
       

     

       91
       91
       -
         (** Date string in RFC3339 format as per Section 1.4 *)

     

       92
       92
       -
         type date = string

     

       93
       93
       -
       

     

       94
       94
       -
         (** UTCDate is a Date with 'Z' time zone as per Section 1.4 *)

     

       95
       95
       -
         type utc_date = string

     

       96
       96
       -
       

     

       97
       97
       -
         (** Error object as per Section 3.6.2 *)

     

       98
       98
       -
         type error = {

     

       99
       99
       -
           type_: string;

     

       100
       100
       -
           description: string option;

     

       101
       101
       -
         }

     

       102
       102
       -
       

     

       103
       103
       -
         (** Set error object as per Section 5.3 *)

     

       104
       104
       -
         type set_error = {

     

       105
       105
       -
           type_: string;

     

       106
       106
       -
           description: string option;

     

       107
       107
       -
           properties: string list option;

     

       108
       108
       -
           (* Additional properties for specific error types *)

     

       109
       109
       -
           existing_id: id option; (* For alreadyExists error *)

     

       110
       110
       -
         }

     

       111
       111
       -
       

     

       112
       112
       -
         (** Invocation object as per Section 3.2 *)

     

       113
       113
       -
         type 'a invocation = {

     

       114
       114
       -
           name: string;

     

       115
       115
       -
           arguments: 'a;

     

       116
       116
       -
           method_call_id: string;

     

       117
       117
       -
         }

     

       118
       118
       -
       

     

       119
       119
       -
         (** ResultReference object as per Section 3.7 *)

     

       120
       120
       -
         type result_reference = {

     

       121
       121
       -
           result_of: string;

     

       122
       122
       -
           name: string;

     

       123
       123
       -
           path: string;

     

       124
       124
       -
         }

     

       125
       125
       -
       

     

       126
       126
       -
         (** FilterOperator, FilterCondition and Filter as per Section 5.5 *)

     

       127
       127
       -
         type filter_operator = {

     

       128
       128
       -
           operator: string; (* "AND", "OR", "NOT" *)

     

       129
       129
       -
           conditions: filter list;

     

       130
       130
       -
         }

     

       131
       131
       -
         and filter_condition = (string * Ezjsonm.value) list

     

       132
       132
       -
         and filter = 

     

       133
       133
       -
           | Operator of filter_operator

     

       134
       134
       -
           | Condition of filter_condition

     

       135
       135
       -
       

     

       136
       136
       -
         (** Comparator object for sorting as per Section 5.5 *)

     

       137
       137
       -
         type comparator = {

     

       138
       138
       -
           property: string;

     

       139
       139
       -
           is_ascending: bool option; (* Optional, defaults to true *)

     

       140
       140
       -
           collation: string option;  (* Optional, server-dependent default *)

     

       141
       141
       -
         }

     

       142
       142
       -
       

     

       143
       143
       -
         (** PatchObject as per Section 5.3 *)

     

       144
       144
       -
         type patch_object = (string * Ezjsonm.value) list

     

       145
       145
       -
       

     

       146
       146
       -
         (** AddedItem structure as per Section 5.6 *)

     

       147
       147
       -
         type added_item = {

     

       148
       148
       -
           id: id;

     

       149
       149
       -
           index: unsigned_int;

     

       150
       150
       -
         }

     

       151
       151
       -
       

     

       152
       152
       -
         (** Account object as per Section 1.6.2 *)

     

       153
       153
       -
         type account = {

     

       154
       154
       -
           name: string;

     

       155
       155
       -
           is_personal: bool;

     

       156
       156
       -
           is_read_only: bool;

     

       157
       157
       -
           account_capabilities: (string * Ezjsonm.value) list;

     

       158
       158
       -
         }

     

       159
       159
       -
       

     

       160
       160
       -
         (** Core capability object as per Section 2 *)

     

       161
       161
       -
         type core_capability = {

     

       162
       162
       -
           max_size_upload: unsigned_int;

     

       163
       163
       -
           max_concurrent_upload: unsigned_int;

     

       164
       164
       -
           max_size_request: unsigned_int;

     

       165
       165
       -
           max_concurrent_requests: unsigned_int;

     

       166
       166
       -
           max_calls_in_request: unsigned_int;

     

       167
       167
       -
           max_objects_in_get: unsigned_int;

     

       168
       168
       -
           max_objects_in_set: unsigned_int;

     

       169
       169
       -
           collation_algorithms: string list;

     

       170
       170
       -
         }

     

       171
       171
       -
       

     

       172
       172
       -
         (** PushSubscription keys object as per Section 7.2 *)

     

       173
       173
       -
         type push_keys = {

     

       174
       174
       -
           p256dh: string;

     

       175
       175
       -
           auth: string;

     

       176
       176
       -
         }

     

       177
       177
       -
       

     

       178
       178
       -
         (** Session object as per Section 2 *)

     

       179
       179
       -
         type session = {

     

       180
       180
       -
           capabilities: (string * Ezjsonm.value) list;

     

       181
       181
       -
           accounts: (id * account) list;

     

       182
       182
       -
           primary_accounts: (string * id) list;

     

       183
       183
       -
           username: string;

     

       184
       184
       -
           api_url: string;

     

       185
       185
       -
           download_url: string;

     

       186
       186
       -
           upload_url: string;

     

       187
       187
       -
           event_source_url: string option;

     

       188
       188
       -
           state: string;

     

       189
       189
       -
         }

     

       190
       190
       -
       

     

       191
       191
       -
         (** TypeState for state changes as per Section 7.1 *)

     

       192
       192
       -
         type type_state = (string * string) list

     

       193
       193
       -
       

     

       194
       194
       -
         (** StateChange object as per Section 7.1 *)

     

       195
       195
       -
         type state_change = {

     

       196
       196
       -
           changed: (id * type_state) list;

     

       197
       197
       -
         }

     

       198
       198
       -
       

     

       199
       199
       -
         (** PushVerification object as per Section 7.2.2 *)

     

       200
       200
       -
         type push_verification = {

     

       201
       201
       -
           push_subscription_id: id;

     

       202
       202
       -
           verification_code: string;

     

       203
       203
       -
         }

     

       204
       204
       -
       

     

       205
       205
       -
         (** PushSubscription object as per Section 7.2 *)

     

       206
       206
       -
         type push_subscription = {

     

       207
       207
       -
           id: id;

     

       208
       208
       -
           device_client_id: string;

     

       209
       209
       -
           url: string;

     

       210
       210
       -
           keys: push_keys option;

     

       211
       211
       -
           verification_code: string option;

     

       212
       212
       -
           expires: utc_date option;

     

       213
       213
       -
           types: string list option;

     

       214
       214
       -
         }

     

       215
       215
       -
       

     

       216
       216
       -
         (** Request object as per Section 3.3 *)

     

       217
       217
       -
         type request = {

     

       218
       218
       -
           using: string list;

     

       219
       219
       -
           method_calls: Ezjsonm.value invocation list;

     

       220
       220
       -
           created_ids: (id * id) list option;

     

       221
       221
       -
         }

     

       222
       222
       -
       

     

       223
       223
       -
         (** Response object as per Section 3.4 *)

     

       224
       224
       -
         type response = {

     

       225
       225
       -
           method_responses: Ezjsonm.value invocation list;

     

       226
       226
       -
           created_ids: (id * id) list option;

     

       227
       227
       -
           session_state: string;

     

       228
       228
       -
         }

     

       229
       229
       -
       

     

       230
       230
       -
         (** Standard method arguments and responses *)

     

       231
       231
       -
       

     

       232
       232
       -
         (** Arguments for Foo/get method as per Section 5.1 *)

     

       233
       233
       -
         type 'a get_arguments = {

     

       234
       234
       -
           account_id: id;

     

       235
       235
       -
           ids: id list option;

     

       236
       236
       -
           properties: string list option;

     

       237
       237
       -
         }

     

       238
       238
       -
       

     

       239
       239
       -
         (** Response for Foo/get method as per Section 5.1 *)

     

       240
       240
       -
         type 'a get_response = {

     

       241
       241
       -
           account_id: id;

     

       242
       242
       -
           state: string;

     

       243
       243
       -
           list: 'a list;

     

       244
       244
       -
           not_found: id list;

     

       245
       245
       -
         }

     

       246
       246
       -
       

     

       247
       247
       -
         (** Arguments for Foo/changes method as per Section 5.2 *)

     

       248
       248
       -
         type changes_arguments = {

     

       249
       249
       -
           account_id: id;

     

       250
       250
       -
           since_state: string;

     

       251
       251
       -
           max_changes: unsigned_int option;

     

       252
       252
       -
         }

     

       253
       253
       -
       

     

       254
       254
       -
         (** Response for Foo/changes method as per Section 5.2 *)

     

       255
       255
       -
         type changes_response = {

     

       256
       256
       -
           account_id: id;

     

       257
       257
       -
           old_state: string;

     

       258
       258
       -
           new_state: string;

     

       259
       259
       -
           has_more_changes: bool;

     

       260
       260
       -
           created: id list;

     

       261
       261
       -
           updated: id list;

     

       262
       262
       -
           destroyed: id list;

     

       263
       263
       -
         }

     

       264
       264
       -
       

     

       265
       265
       -
         (** Arguments for Foo/set method as per Section 5.3 *)

     

       266
       266
       -
         type 'a set_arguments = {

     

       267
       267
       -
           account_id: id;

     

       268
       268
       -
           if_in_state: string option;

     

       269
       269
       -
           create: (id * 'a) list option;

     

       270
       270
       -
           update: (id * patch_object) list option;

     

       271
       271
       -
           destroy: id list option;

     

       272
       272
       -
         }

     

       273
       273
       -
       

     

       274
       274
       -
         (** Response for Foo/set method as per Section 5.3 *)

     

       275
       275
       -
         type 'a set_response = {

     

       276
       276
       -
           account_id: id;

     

       277
       277
       -
           old_state: string option;

     

       278
       278
       -
           new_state: string;

     

       279
       279
       -
           created: (id * 'a) list option;

     

       280
       280
       -
           updated: (id * 'a option) list option;

     

       281
       281
       -
           destroyed: id list option;

     

       282
       282
       -
           not_created: (id * set_error) list option;

     

       283
       283
       -
           not_updated: (id * set_error) list option;

     

       284
       284
       -
           not_destroyed: (id * set_error) list option;

     

       285
       285
       -
         }

     

       286
       286
       -
       

     

       287
       287
       -
         (** Arguments for Foo/copy method as per Section 5.4 *)

     

       288
       288
       -
         type 'a copy_arguments = {

     

       289
       289
       -
           from_account_id: id;

     

       290
       290
       -
           if_from_in_state: string option;

     

       291
       291
       -
           account_id: id;

     

       292
       292
       -
           if_in_state: string option;

     

       293
       293
       -
           create: (id * 'a) list;

     

       294
       294
       -
           on_success_destroy_original: bool option;

     

       295
       295
       -
           destroy_from_if_in_state: string option;

     

       296
       296
       -
         }

     

       297
       297
       -
       

     

       298
       298
       -
         (** Response for Foo/copy method as per Section 5.4 *)

     

       299
       299
       -
         type 'a copy_response = {

     

       300
       300
       -
           from_account_id: id;

     

       301
       301
       -
           account_id: id;

     

       302
       302
       -
           old_state: string option;

     

       303
       303
       -
           new_state: string;

     

       304
       304
       -
           created: (id * 'a) list option;

     

       305
       305
       -
           not_created: (id * set_error) list option;

     

       306
       306
       -
         }

     

       307
       307
       -
       

     

       308
       308
       -
         (** Arguments for Foo/query method as per Section 5.5 *)

     

       309
       309
       -
         type query_arguments = {

     

       310
       310
       -
           account_id: id;

     

       311
       311
       -
           filter: filter option;

     

       312
       312
       -
           sort: comparator list option;

     

       313
       313
       -
           position: int_t option;

     

       314
       314
       -
           anchor: id option;

     

       315
       315
       -
           anchor_offset: int_t option;

     

       316
       316
       -
           limit: unsigned_int option;

     

       317
       317
       -
           calculate_total: bool option;

     

       318
       318
       -
         }

     

       319
       319
       -
       

     

       320
       320
       -
         (** Response for Foo/query method as per Section 5.5 *)

     

       321
       321
       -
         type query_response = {

     

       322
       322
       -
           account_id: id;

     

       323
       323
       -
           query_state: string;

     

       324
       324
       -
           can_calculate_changes: bool;

     

       325
       325
       -
           position: unsigned_int;

     

       326
       326
       -
           ids: id list;

     

       327
       327
       -
           total: unsigned_int option;

     

       328
       328
       -
           limit: unsigned_int option;

     

       329
       329
       -
         }

     

       330
       330
       -
       

     

       331
       331
       -
         (** Arguments for Foo/queryChanges method as per Section 5.6 *)

     

       332
       332
       -
         type query_changes_arguments = {

     

       333
       333
       -
           account_id: id;

     

       334
       334
       -
           filter: filter option;

     

       335
       335
       -
           sort: comparator list option;

     

       336
       336
       -
           since_query_state: string;

     

       337
       337
       -
           max_changes: unsigned_int option;

     

       338
       338
       -
           up_to_id: id option;

     

       339
       339
       -
           calculate_total: bool option;

     

       340
       340
       -
         }

     

       341
       341
       -
       

     

       342
       342
       -
         (** Response for Foo/queryChanges method as per Section 5.6 *)

     

       343
       343
       -
         type query_changes_response = {

     

       344
       344
       -
           account_id: id;

     

       345
       345
       -
           old_query_state: string;

     

       346
       346
       -
           new_query_state: string;

     

       347
       347
       -
           total: unsigned_int option;

     

       348
       348
       -
           removed: id list;

     

       349
       349
       -
           added: added_item list option;

     

       350
       350
       -
         }

     

       351
       351
       -
       

     

       352
       352
       -
         (** Arguments for Blob/copy method as per Section 6.3 *)

     

       353
       353
       -
         type blob_copy_arguments = {

     

       354
       354
       -
           from_account_id: id;

     

       355
       355
       -
           account_id: id;

     

       356
       356
       -
           blob_ids: id list;

     

       357
       357
       -
         }

     

       358
       358
       -
       

     

       359
       359
       -
         (** Response for Blob/copy method as per Section 6.3 *)

     

       360
       360
       -
         type blob_copy_response = {

     

       361
       361
       -
           from_account_id: id;

     

       362
       362
       -
           account_id: id;

     

       363
       363
       -
           copied: (id * id) list option;

     

       364
       364
       -
           not_copied: (id * set_error) list option;

     

       365
       365
       -
         }

     

       366
       366
       -
       

     

       367
       367
       -
         (** Upload response as per Section 6.1 *)

     

       368
       368
       -
         type upload_response = {

     

       369
       369
       -
           account_id: id;

     

       370
       370
       -
           blob_id: id;

     

       371
       371
       -
           type_: string;

     

       372
       372
       -
           size: unsigned_int;

     

       373
       373
       -
         }

     

       374
       374
       -
       

     

       375
       375
       -
         (** Problem details object as per RFC7807 and Section 3.6.1 *)

     

       376
       376
       -
         type problem_details = {

     

       377
       377
       -
           type_: string;

     

       378
       378
       -
           status: int option;

     

       379
       379
       -
           detail: string option;

     

       380
       380
       -
           limit: string option; (* For "limit" error *)

     

       381
       381
       -
         }

     

       382
       382
       -
       end

     

       383
       383
       -
       

     

       384
       384
       -
       (** Module for working with ResultReferences as described in Section 3.7 of RFC8620 *)

     

       385
       385
       -
       module ResultReference = struct

     

       386
       386
       -
         open Types

     

       387
       387
       -
       

     

       388
       388
       -
         (** Create a reference to a previous method result *)

     

       389
       389
       -
         let create ~result_of ~name ~path = 

     

       390
       390
       -
           { result_of; name; path }

     

       391
       391
       -
         

     

       392
       392
       -
         (** Create a JSON pointer path to access a specific property *)

     

       393
       393
       -
         let property_path property =

     

       394
       394
       -
           "/" ^ property

     

       395
       395
       -
         

     

       396
       396
       -
         (** Create a JSON pointer path to access all items in an array with a specific property *)

     

       397
       397
       -
         let array_items_path ?(property="") array_property =

     

       398
       398
       -
           let base = "/" ^ array_property ^ "/*" in

     

       399
       399
       -
           if property = "" then base

     

       400
       400
       -
           else base ^ "/" ^ property

     

       401
       401
       -
         

     

       402
       402
       -
         (** Create argument with result reference.

     

       403
       403
       -
             Returns string key prefixed with # and ResultReference value. *)

     

       404
       404
       -
         let reference_arg arg_name ref_obj =

     

       405
       405
       -
           (* Prefix argument name with # *)

     

       406
       406
       -
           let prefixed_name = "#" ^ arg_name in

     

       407
       407
       -
           

     

       408
       408
       -
           (* Convert reference object to JSON *)

     

       409
       409
       -
           let json_value = `O [

     

       410
       410
       -
             ("resultOf", `String ref_obj.result_of);

     

       411
       411
       -
             ("name", `String ref_obj.name);

     

       412
       412
       -
             ("path", `String ref_obj.path)

     

       413
       413
       -
           ] in

     

       414
       414
       -
           

     

       415
       415
       -
           (prefixed_name, json_value)

     

       416
       416
       -
         

     

       417
       417
       -
         (** Create a reference to all IDs returned by a query method *)

     

       418
       418
       -
         let query_ids ~result_of =

     

       419
       419
       -
           create

     

       420
       420
       -
             ~result_of

     

       421
       421
       -
             ~name:"Foo/query"

     

       422
       422
       -
             ~path:"/ids"

     

       423
       423
       -
         

     

       424
       424
       -
         (** Create a reference to properties of objects returned by a get method *)

     

       425
       425
       -
         let get_property ~result_of ~property =

     

       426
       426
       -
           create

     

       427
       427
       -
             ~result_of

     

       428
       428
       -
             ~name:"Foo/get"

     

       429
       429
       -
             ~path:("/list/*/" ^ property)

     

       430
       430
       -
       end

     

       431
       431
       -
       

     

       432
       432
       -
       module Api = struct

     

       433
       433
       -
         open Lwt.Syntax

     

       434
       434
       -
         open Types

     

       435
       435
       -
       

     

       436
       436
       -
         (** Error that may occur during API requests *)

     

       437
       437
       -
         type error =

     

       438
       438
       -
           | Connection_error of string

     

       439
       439
       -
           | HTTP_error of int * string

     

       440
       440
       -
           | Parse_error of string

     

       441
       441
       -
           | Authentication_error

     

       442
       442
       -
       

     

       443
       443
       -
         (** Result type for API operations *)

     

       444
       444
       -
         type 'a result = ('a, error) Stdlib.result

     

       445
       445
       -
         

     

       446
       446
       -
         (** Convert an error to a human-readable string *)

     

       447
       447
       -
         let string_of_error = function

     

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

     

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

     

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

     

       451
       451
       -
           | Authentication_error -> "Authentication error"

     

       452
       452
       -
         

     

       453
       453
       -
         (** Pretty-print an error to a formatter *)

     

       454
       454
       -
         let pp_error ppf err =

     

       455
       455
       -
           Format.fprintf ppf "%s" (string_of_error err)

     

       456
       456
       -
       

     

       457
       457
       -
         (** Configuration for a JMAP API client *)

     

       458
       458
       -
         type config = {

     

       459
       459
       -
           api_uri: Uri.t;

     

       460
       460
       -
           username: string;

     

       461
       461
       -
           authentication_token: string;

     

       462
       462
       -
         }

     

       463
       463
       -
       

     

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

     

       465
       465
       -
         let json_to_string json =

     

       466
       466
       -
           Ezjsonm.value_to_string ~minify:false json

     

       467
       467
       -
       

     

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

     

       469
       469
       -
         let parse_json_string str =

     

       470
       470
       -
           try Ok (Ezjsonm.from_string str)

     

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

     

       472
       472
       -
       

     

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

     

       474
       474
       -
         let parse_response json =

     

       475
       475
       -
           try

     

       476
       476
       -
             let method_responses =

     

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

     

       478
       478
       -
               | `A items ->

     

       479
       479
       -
                   List.map (fun json ->

     

       480
       480
       -
                     match json with

     

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

     

       482
       482
       -
                         { name; arguments = args; method_call_id }

     

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

     

       484
       484
       -
                   ) items

     

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

     

       486
       486
       -
             in

     

       487
       487
       -
             let created_ids_opt =

     

       488
       488
       -
               try

     

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

     

       490
       490
       -
                 match obj with

     

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

     

       492
       492
       -
                     match v with

     

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

     

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

     

       495
       495
       -
                   ) items)

     

       496
       496
       -
                 | _ -> None

     

       497
       497
       -
               with Not_found -> None

     

       498
       498
       -
             in

     

       499
       499
       -
             let session_state =

     

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

     

       501
       501
       -
               | `String s -> s

     

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

     

       503
       503
       -
             in

     

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

     

       505
       505
       -
           with

     

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

     

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

     

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

     

       509
       509
       -
       

     

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

     

       511
       511
       -
         let serialize_request req =

     

       512
       512
       -
           let method_calls_json =

     

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

     

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

     

       515
       515
       -
             ) req.method_calls)

     

       516
       516
       -
           in

     

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

     

       518
       518
       -
           let json = `O [

     

       519
       519
       -
             ("using", using_json);

     

       520
       520
       -
             ("methodCalls", method_calls_json)

     

       521
       521
       -
           ] in

     

       522
       522
       -
           let json = match req.created_ids with

     

       523
       523
       -
             | Some ids ->

     

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

     

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

     

       526
       526
       -
             | None -> json

     

       527
       527
       -
           in

     

       528
       528
       -
           json_to_string json

     

       529
       529
       -
       

     

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

     

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

     

       532
       532
       -
           let open Cohttp in

     

       533
       533
       -
           let open Cohttp_lwt_unix in

     

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

     

       535
       535
       -
           

     

       536
       536
       -
           (* Print detailed request information to stderr for debugging *)

     

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

     

       538
       538
       -
           let redacted_headers = redact_headers header_list in

     

       539
       539
       -
           Logs.info (fun m -> 

     

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

     

       541
       541
       -
                URI: %s\n\

     

       542
       542
       -
                METHOD: %s\n\

     

       543
       543
       -
                HEADERS:\n%s\n\

     

       544
       544
       -
                BODY:\n%s\n\

     

       545
       545
       -
                ======================\n"

     

       546
       546
       -
               (Uri.to_string uri)

     

       547
       547
       -
               method_

     

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

     

       549
       549
       -
               body);

     

       550
       550
       -
           

     

       551
       551
       -
           (* Force printing to stderr for immediate debugging *)

     

       552
       552
       -
           Printf.eprintf "[DEBUG-REQUEST] URI: %s\n" (Uri.to_string uri);

     

       553
       553
       -
           Printf.eprintf "[DEBUG-REQUEST] METHOD: %s\n" method_;

     

       554
       554
       -
           Printf.eprintf "[DEBUG-REQUEST] BODY: %s\n%!" body;

     

       555
       555
       -
           

     

       556
       556
       -
           Lwt.catch

     

       557
       557
       -
             (fun () ->

     

       558
       558
       -
               let* resp, body = 

     

       559
       559
       -
                 match method_ with

     

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

     

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

     

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

     

       563
       563
       -
               in

     

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

     

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

     

       566
       566
       -
               

     

       567
       567
       -
               (* Print detailed response information to stderr for debugging *)

     

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

     

       569
       569
       -
               let redacted_headers = redact_headers header_list in

     

       570
       570
       -
               Logs.info (fun m -> 

     

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

     

       572
       572
       -
                    STATUS: %d\n\

     

       573
       573
       -
                    HEADERS:\n%s\n\

     

       574
       574
       -
                    BODY:\n%s\n\

     

       575
       575
       -
                    ======================\n"

     

       576
       576
       -
                   status

     

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

     

       578
       578
       -
                   body_str);

     

       579
       579
       -
               

     

       580
       580
       -
               (* Force printing to stderr for immediate debugging *)

     

       581
       581
       -
               Printf.eprintf "[DEBUG-RESPONSE] STATUS: %d\n" status;

     

       582
       582
       -
               Printf.eprintf "[DEBUG-RESPONSE] BODY: %s\n%!" body_str;

     

       583
       583
       -
               

     

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

     

       585
       585
       -
                 Lwt.return (Ok body_str)

     

       586
       586
       -
               else

     

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

     

       588
       588
       -
             (fun e -> 

     

       589
       589
       -
               let error_msg = Printexc.to_string e in

     

       590
       590
       -
               Printf.eprintf "[DEBUG-ERROR] %s\n%!" error_msg;

     

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

     

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

     

       593
       593
       -
       

     

       594
       594
       -
         (** Make a raw JMAP API request 

     

       595
       595
       -
             

     

       596
       596
       -
             TODO:claude *)

     

       597
       597
       -
         let make_request config req =

     

       598
       598
       -
           let body = serialize_request req in

     

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

     

       600
       600
       -
           let auth_header = 

     

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

     

       602
       602
       -
               (* Standard username/password authentication *)

     

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

     

       604
       604
       -
             else

     

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

     

       606
       606
       -
               "Bearer " ^ config.authentication_token

     

       607
       607
       -
           in

     

       608
       608
       -
           

     

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

     

       610
       610
       -
           let redacted_header =

     

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

     

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

     

       613
       613
       -
             else

     

       614
       614
       -
               "Bearer " ^ redact_token config.authentication_token

     

       615
       615
       -
           in

     

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

     

       617
       617
       -
           

     

       618
       618
       -
           let headers = [

     

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

     

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

     

       621
       621
       -
             ("Authorization", auth_header)

     

       622
       622
       -
           ] in

     

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

     

       624
       624
       -
           match result with

     

       625
       625
       -
           | Ok response_body ->

     

       626
       626
       -
               (match parse_json_string response_body with

     

       627
       627
       -
                | Ok json -> 

     

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

     

       629
       629
       -
                    Lwt.return (parse_response json)

     

       630
       630
       -
                | Error e -> 

     

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

     

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

     

       633
       633
       -
                    Lwt.return (Error e))

     

       634
       634
       -
           | Error e -> 

     

       635
       635
       -
               (match e with

     

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

     

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

     

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

     

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

     

       640
       640
       -
               Lwt.return (Error e)

     

       641
       641
       -
       

     

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

     

       643
       643
       -
         let parse_session_object json =

     

       644
       644
       -
           try

     

       645
       645
       -
             let capabilities =

     

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

     

       647
       647
       -
               | `O items -> items

     

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

     

       649
       649
       -
             in

     

       650
       650
       -
             

     

       651
       651
       -
             let accounts =

     

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

     

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

     

       654
       654
       -
                   match json with

     

       655
       655
       -
                   | `O _ -> 

     

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

     

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

     

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

     

       659
       659
       -
                       let account_capabilities =

     

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

     

       661
       661
       -
                         | `O items -> items

     

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

     

       663
       663
       -
                       in

     

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

     

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

     

       666
       666
       -
                 ) items

     

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

     

       668
       668
       -
             in

     

       669
       669
       -
             

     

       670
       670
       -
             let primary_accounts =

     

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

     

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

     

       673
       673
       -
                   match v with

     

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

     

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

     

       676
       676
       -
                 ) items

     

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

     

       678
       678
       -
               | None -> []

     

       679
       679
       -
             in

     

       680
       680
       -
             

     

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

     

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

     

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

     

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

     

       685
       685
       -
             let event_source_url = 

     

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

     

       687
       687
       -
               with Not_found -> None

     

       688
       688
       -
             in

     

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

     

       690
       690
       -
             

     

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

     

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

     

       693
       693
       -
           with

     

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

     

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

     

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

     

       697
       697
       -
       

     

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

     

       699
       699
       -
             

     

       700
       700
       -
             TODO:claude *)

     

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

     

       702
       702
       -
           let headers = 

     

       703
       703
       -
             match (username, authentication_token, api_token) with

     

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

     

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

     

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

     

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

     

       708
       708
       -
                 [

     

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

     

       710
       710
       -
                   ("Authorization", auth)

     

       711
       711
       -
                 ]

     

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

     

       713
       713
       -
                 let auth = "Bearer " ^ token in

     

       714
       714
       -
                 let redacted_token = redact_token token in

     

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

     

       716
       716
       -
                 [

     

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

     

       718
       718
       -
                   ("Authorization", auth)

     

       719
       719
       -
                 ]

     

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

     

       721
       721
       -
           in

     

       722
       722
       -
           

     

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

     

       724
       724
       -
           match result with

     

       725
       725
       -
           | Ok response_body ->

     

       726
       726
       -
               (match parse_json_string response_body with

     

       727
       727
       -
                | Ok json -> 

     

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

     

       729
       729
       -
                    Lwt.return (parse_session_object json)

     

       730
       730
       -
                | Error e -> 

     

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

     

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

     

       733
       733
       -
                    Lwt.return (Error e))

     

       734
       734
       -
           | Error e -> 

     

       735
       735
       -
               let err_msg = match e with

     

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

     

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

     

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

     

       739
       739
       -
                | Authentication_error -> "Authentication error"

     

       740
       740
       -
               in

     

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

     

       742
       742
       -
               Lwt.return (Error e)

     

       743
       743
       -
       

     

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

     

       745
       745
       -
             

     

       746
       746
       -
             TODO:claude *)

     

       747
       747
       -
         let upload_blob config ~account_id ~content_type data =

     

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

     

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

     

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

     

       751
       751
       -
           let upload_uri = Uri.of_string upload_url in

     

       752
       752
       -
           

     

       753
       753
       -
           let headers = [

     

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

     

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

     

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

     

       757
       757
       -
           ] in

     

       758
       758
       -
           

     

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

     

       760
       760
       -
           match result with

     

       761
       761
       -
           | Ok response_body ->

     

       762
       762
       -
               (match parse_json_string response_body with

     

       763
       763
       -
                | Ok json ->

     

       764
       764
       -
                    (try

     

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

     

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

     

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

     

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

     

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

     

       770
       770
       -
                     with

     

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

     

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

     

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

     

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

     

       775
       775
       -
       

     

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

     

       777
       777
       -
             

     

       778
       778
       -
             TODO:claude *)

     

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

     

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

     

       781
       781
       -
           

     

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

     

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

     

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

     

       785
       785
       -
           

     

       786
       786
       -
           let url = match type_ with

     

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

     

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

     

       789
       789
       -
           in

     

       790
       790
       -
           

     

       791
       791
       -
           let url = match name with

     

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

     

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

     

       794
       794
       -
           in

     

       795
       795
       -
           

     

       796
       796
       -
           let download_uri = Uri.of_string url in

     

       797
       797
       -
           

     

       798
       798
       -
           let headers = [

     

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

     

       800
       800
       -
           ] in

     

       801
       801
       -
           

     

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

     

       803
       803
       -
           Lwt.return result

     

       804
       804
       -
       end

-663

lib/jmap.mli

···

       1
       1
       -
       (**

     

       2
       2
       -
        * JMAP protocol implementation based on RFC8620

     

       3
       3
       -
        * https://datatracker.ietf.org/doc/html/rfc8620

     

       4
       4
       -
        *

     

       5
       5
       -
        * This module implements the core JMAP protocol as defined in RFC8620, providing

     

       6
       6
       -
        * types and functions for making JMAP API requests and handling responses.

     

       7
       7
       -
        *)

     

       8
       8
       -
       

     

       9
       9
       -
       (** Initialize and configure logging for JMAP

     

       10
       10
       -
           @param level Optional logging level (higher means more verbose)

     

       11
       11
       -
           @param enable_logs Whether to enable logging at all (default true)

     

       12
       12
       -
           @param redact_sensitive Whether to redact sensitive information like tokens (default true)

     

       13
       13
       -
        *)

     

       14
       14
       -
       val init_logging : ?level:int -> ?enable_logs:bool -> ?redact_sensitive:bool -> unit -> unit

     

       15
       15
       -
       

     

       16
       16
       -
       (** Redact sensitive data like authentication tokens from logs

     

       17
       17
       -
           @param redact Whether to perform redaction (default true)

     

       18
       18
       -
           @param token The token string to redact

     

       19
       19
       -
           @return A redacted version of the token (with characters replaced by '*')

     

       20
       20
       -
        *)

     

       21
       21
       -
       val redact_token : ?redact:bool -> string -> string

     

       22
       22
       -
       

     

       23
       23
       -
       (** Module for managing JMAP capability URIs and other constants 

     

       24
       24
       -
           as defined in RFC8620 Section 1.8

     

       25
       25
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8

     

       26
       26
       -
       *)

     

       27
       27
       -
       module Capability : sig

     

       28
       28
       -
         (** JMAP core capability URI as specified in RFC8620 Section 2

     

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

     

       30
       30
       -
         *)

     

       31
       31
       -
         val core_uri : string

     

       32
       32
       -
       

     

       33
       33
       -
         (** All JMAP capability types as described in RFC8620 Section 1.8

     

       34
       34
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8

     

       35
       35
       -
         *)

     

       36
       36
       -
         type t = 

     

       37
       37
       -
           | Core       (** Core JMAP capability *)

     

       38
       38
       -
           | Extension of string  (** Extension capabilities with custom URIs *)

     

       39
       39
       -
       

     

       40
       40
       -
         (** Convert capability to URI string

     

       41
       41
       -
             @param capability The capability to convert

     

       42
       42
       -
             @return The full URI string for the capability

     

       43
       43
       -
         *)

     

       44
       44
       -
         val to_string : t -> string

     

       45
       45
       -
       

     

       46
       46
       -
         (** Parse a string to a capability, returns Extension for non-core capabilities

     

       47
       47
       -
             @param uri The capability URI string to parse

     

       48
       48
       -
             @return The parsed capability type

     

       49
       49
       -
         *)

     

       50
       50
       -
         val of_string : string -> t

     

       51
       51
       -
           

     

       52
       52
       -
         (** Check if a capability matches the core capability

     

       53
       53
       -
             @param capability The capability to check

     

       54
       54
       -
             @return True if the capability is the core JMAP capability

     

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

     

       56
       56
       -
         *)

     

       57
       57
       -
         val is_core : t -> bool

     

       58
       58
       -
       

     

       59
       59
       -
         (** Check if a capability string is the core capability URI

     

       60
       60
       -
             @param uri The capability URI string to check

     

       61
       61
       -
             @return True if the string represents the core JMAP capability

     

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

     

       63
       63
       -
         *)

     

       64
       64
       -
         val is_core_string : string -> bool

     

       65
       65
       -
       

     

       66
       66
       -
         (** Create a list of capability URI strings

     

       67
       67
       -
             @param capabilities List of capability types

     

       68
       68
       -
             @return List of capability URI strings

     

       69
       69
       -
         *)

     

       70
       70
       -
         val strings_of_capabilities : t list -> string list

     

       71
       71
       -
       end

     

       72
       72
       -
       

     

       73
       73
       -
       (** {1 Types}

     

       74
       74
       -
           Core types as defined in RFC8620

     

       75
       75
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620> RFC8620

     

       76
       76
       -
       *)

     

       77
       77
       -
       

     

       78
       78
       -
       module Types : sig

     

       79
       79
       -
         (** Id string as defined in RFC8620 Section 1.2.

     

       80
       80
       -
             A string of at least 1 and maximum 255 octets, case-sensitive, 

     

       81
       81
       -
             and does not begin with the '#' character.

     

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

     

       83
       83
       -
         *)

     

       84
       84
       -
         type id = string

     

       85
       85
       -
       

     

       86
       86
       -
         (** Int type bounded within the range -2^53+1 to 2^53-1 as defined in RFC8620 Section 1.3.

     

       87
       87
       -
             Represented as JSON number where the value MUST be an integer and in the range.

     

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

     

       89
       89
       -
         *)

     

       90
       90
       -
         type int_t = int

     

       91
       91
       -
       

     

       92
       92
       -
         (** UnsignedInt bounded within the range 0 to 2^53-1 as defined in RFC8620 Section 1.3.

     

       93
       93
       -
             Represented as JSON number where the value MUST be a non-negative integer and in the range.

     

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

     

       95
       95
       -
         *)

     

       96
       96
       -
         type unsigned_int = int

     

       97
       97
       -
       

     

       98
       98
       -
         (** Date string in RFC3339 format as defined in RFC8620 Section 1.4.

     

       99
       99
       -
             Includes date, time and time zone offset information or UTC.

     

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

     

       101
       101
       -
         *)

     

       102
       102
       -
         type date = string

     

       103
       103
       -
       

     

       104
       104
       -
         (** UTCDate is a Date with 'Z' time zone (UTC) as defined in RFC8620 Section 1.4.

     

       105
       105
       -
             Same format as Date type but always with UTC time zone (Z).

     

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

     

       107
       107
       -
         *)

     

       108
       108
       -
         type utc_date = string

     

       109
       109
       -
       

     

       110
       110
       -
         (** Error object as defined in RFC8620 Section 3.6.2.

     

       111
       111
       -
             Used to represent standard error conditions in method responses.

     

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

     

       113
       113
       -
         *)

     

       114
       114
       -
         type error = {

     

       115
       115
       -
           type_: string;  (** The type of error, e.g., "serverFail" *)

     

       116
       116
       -
           description: string option;  (** Optional human-readable description of the error *)

     

       117
       117
       -
         }

     

       118
       118
       -
       

     

       119
       119
       -
         (** Set error object as defined in RFC8620 Section 5.3.

     

       120
       120
       -
             Used for reporting errors in set operations.

     

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

     

       122
       122
       -
         *)

     

       123
       123
       -
         type set_error = {

     

       124
       124
       -
           type_: string;  (** The type of error, e.g., "notFound" *)

     

       125
       125
       -
           description: string option;  (** Optional human-readable description of the error *)

     

       126
       126
       -
           properties: string list option;  (** Properties causing the error, if applicable *)

     

       127
       127
       -
           existing_id: id option;  (** For "alreadyExists" error, the ID of the existing object *)

     

       128
       128
       -
         }

     

       129
       129
       -
       

     

       130
       130
       -
         (** Invocation object as defined in RFC8620 Section 3.2.

     

       131
       131
       -
             Represents a method call in the JMAP protocol.

     

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

     

       133
       133
       -
         *)

     

       134
       134
       -
         type 'a invocation = {

     

       135
       135
       -
           name: string;  (** The name of the method to call, e.g., "Mailbox/get" *)

     

       136
       136
       -
           arguments: 'a;  (** The arguments for the method, type varies by method *)

     

       137
       137
       -
           method_call_id: string;  (** Client-specified ID for referencing this call *)

     

       138
       138
       -
         }

     

       139
       139
       -
       

     

       140
       140
       -
         (** ResultReference object as defined in RFC8620 Section 3.7.

     

       141
       141
       -
             Used to reference results from previous method calls.

     

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

     

       143
       143
       -
         *)

     

       144
       144
       -
         type result_reference = {

     

       145
       145
       -
           result_of: string;  (** The method_call_id of the method to reference *)

     

       146
       146
       -
           name: string;  (** Name of the response in the referenced result *)

     

       147
       147
       -
           path: string;  (** JSON pointer path to the value being referenced *)

     

       148
       148
       -
         }

     

       149
       149
       -
       

     

       150
       150
       -
         (** FilterOperator, FilterCondition and Filter as defined in RFC8620 Section 5.5.

     

       151
       151
       -
             Used for complex filtering in query methods.

     

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

     

       153
       153
       -
         *)

     

       154
       154
       -
         type filter_operator = {

     

       155
       155
       -
           operator: string;  (** The operator: "AND", "OR", "NOT" *)

     

       156
       156
       -
           conditions: filter list;  (** The conditions to apply the operator to *)

     

       157
       157
       -
         }

     

       158
       158
       -
        

     

       159
       159
       -
         (** Property/value pairs for filtering *)

     

       160
       160
       -
         and filter_condition =

     

       161
       161
       -
           (string * Ezjsonm.value) list 

     

       162
       162
       -
       

     

       163
       163
       -
         and filter = 

     

       164
       164
       -
           | Operator of filter_operator  (** Logical operator combining conditions *)

     

       165
       165
       -
           | Condition of filter_condition  (** Simple property-based condition *)

     

       166
       166
       -
       

     

       167
       167
       -
         (** Comparator object for sorting as defined in RFC8620 Section 5.5.

     

       168
       168
       -
             Specifies how to sort query results.

     

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

     

       170
       170
       -
         *)

     

       171
       171
       -
         type comparator = {

     

       172
       172
       -
           property: string;  (** The property to sort by *)

     

       173
       173
       -
           is_ascending: bool option;  (** Sort order (true for ascending, false for descending) *)

     

       174
       174
       -
           collation: string option;  (** Collation algorithm for string comparison *)

     

       175
       175
       -
         }

     

       176
       176
       -
       

     

       177
       177
       -
         (** PatchObject as defined in RFC8620 Section 5.3.

     

       178
       178
       -
             Used to represent a set of updates to apply to an object.

     

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

     

       180
       180
       -
         *)

     

       181
       181
       -
         type patch_object = (string * Ezjsonm.value) list  (** List of property/value pairs to update *)

     

       182
       182
       -
       

     

       183
       183
       -
         (** AddedItem structure as defined in RFC8620 Section 5.6.

     

       184
       184
       -
             Represents an item added to a query result.

     

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

     

       186
       186
       -
         *)

     

       187
       187
       -
         type added_item = {

     

       188
       188
       -
           id: id;  (** The ID of the added item *)

     

       189
       189
       -
           index: unsigned_int;  (** The index in the result list where the item appears *)

     

       190
       190
       -
         }

     

       191
       191
       -
       

     

       192
       192
       -
         (** Account object as defined in RFC8620 Section 1.6.2.

     

       193
       193
       -
             Represents a user account in JMAP.

     

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

     

       195
       195
       -
         *)

     

       196
       196
       -
         type account = {

     

       197
       197
       -
           name: string;  (** User-friendly account name, e.g. "john@example.com" *)

     

       198
       198
       -
           is_personal: bool;  (** Whether this account belongs to the authenticated user *)

     

       199
       199
       -
           is_read_only: bool;  (** Whether this account can be modified *)

     

       200
       200
       -
           account_capabilities: (string * Ezjsonm.value) list;  (** Capabilities available for this account *)

     

       201
       201
       -
         }

     

       202
       202
       -
       

     

       203
       203
       -
         (** Core capability object as defined in RFC8620 Section 2.

     

       204
       204
       -
             Describes limits and features of the JMAP server.

     

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

     

       206
       206
       -
         *)

     

       207
       207
       -
         type core_capability = {

     

       208
       208
       -
           max_size_upload: unsigned_int;  (** Maximum file size in octets for uploads *)

     

       209
       209
       -
           max_concurrent_upload: unsigned_int;  (** Maximum number of concurrent uploads *)

     

       210
       210
       -
           max_size_request: unsigned_int;  (** Maximum size in octets for a request *)

     

       211
       211
       -
           max_concurrent_requests: unsigned_int;  (** Maximum number of concurrent requests *)

     

       212
       212
       -
           max_calls_in_request: unsigned_int;  (** Maximum number of method calls in a request *)

     

       213
       213
       -
           max_objects_in_get: unsigned_int;  (** Maximum number of objects in a get request *)

     

       214
       214
       -
           max_objects_in_set: unsigned_int;  (** Maximum number of objects in a set request *)

     

       215
       215
       -
           collation_algorithms: string list;  (** Supported string collation algorithms *)

     

       216
       216
       -
         }

     

       217
       217
       -
       

     

       218
       218
       -
         (** PushSubscription keys object as defined in RFC8620 Section 7.2.

     

       219
       219
       -
             Contains encryption keys for web push subscriptions.

     

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

     

       221
       221
       -
         *)

     

       222
       222
       -
         type push_keys = {

     

       223
       223
       -
           p256dh: string;  (** User agent public key (Base64url-encoded) *)

     

       224
       224
       -
           auth: string;  (** Authentication secret (Base64url-encoded) *)

     

       225
       225
       -
         }

     

       226
       226
       -
       

     

       227
       227
       -
         (** Session object as defined in RFC8620 Section 2.

     

       228
       228
       -
             Contains information about the server and user's accounts.

     

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

     

       230
       230
       -
         *)

     

       231
       231
       -
         type session = {

     

       232
       232
       -
           capabilities: (string * Ezjsonm.value) list;  (** Server capabilities with their properties *)

     

       233
       233
       -
           accounts: (id * account) list;  (** Map of account IDs to account objects *)

     

       234
       234
       -
           primary_accounts: (string * id) list;  (** Map of capability URIs to primary account IDs *)

     

       235
       235
       -
           username: string;  (** Username associated with this session *)

     

       236
       236
       -
           api_url: string;  (** URL to use for JMAP API requests *)

     

       237
       237
       -
           download_url: string;  (** URL endpoint to download files *)

     

       238
       238
       -
           upload_url: string;  (** URL endpoint to upload files *)

     

       239
       239
       -
           event_source_url: string option;  (** URL for Server-Sent Events notifications *)

     

       240
       240
       -
           state: string;  (** String representing the state on the server *)

     

       241
       241
       -
         }

     

       242
       242
       -
       

     

       243
       243
       -
         (** TypeState for state changes as defined in RFC8620 Section 7.1.

     

       244
       244
       -
             Maps data type names to the state string for that type.

     

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

     

       246
       246
       -
         *)

     

       247
       247
       -
         type type_state = (string * string) list  (** (data type name, state string) pairs *)

     

       248
       248
       -
       

     

       249
       249
       -
         (** StateChange object as defined in RFC8620 Section 7.1.

     

       250
       250
       -
             Represents changes to data types for different accounts.

     

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

     

       252
       252
       -
         *)

     

       253
       253
       -
         type state_change = {

     

       254
       254
       -
           changed: (id * type_state) list;  (** Map of account IDs to type state changes *)

     

       255
       255
       -
         }

     

       256
       256
       -
       

     

       257
       257
       -
         (** PushVerification object as defined in RFC8620 Section 7.2.2.

     

       258
       258
       -
             Used for verifying push subscription ownership.

     

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

     

       260
       260
       -
         *)

     

       261
       261
       -
         type push_verification = {

     

       262
       262
       -
           push_subscription_id: id;  (** ID of the push subscription being verified *)

     

       263
       263
       -
           verification_code: string;  (** Code the client must submit to verify ownership *)

     

       264
       264
       -
         }

     

       265
       265
       -
       

     

       266
       266
       -
         (** PushSubscription object as defined in RFC8620 Section 7.2.

     

       267
       267
       -
             Represents a subscription for push notifications.

     

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

     

       269
       269
       -
         *)

     

       270
       270
       -
         type push_subscription = {

     

       271
       271
       -
           id: id;  (** Server-assigned ID for the subscription *)

     

       272
       272
       -
           device_client_id: string;  (** ID representing the client/device *)

     

       273
       273
       -
           url: string;  (** URL to which events are pushed *)

     

       274
       274
       -
           keys: push_keys option;  (** Encryption keys for web push, if any *)

     

       275
       275
       -
           verification_code: string option;  (** Verification code if not yet verified *)

     

       276
       276
       -
           expires: utc_date option;  (** When the subscription expires, if applicable *)

     

       277
       277
       -
           types: string list option;  (** Types of changes to push, null means all *)

     

       278
       278
       -
         }

     

       279
       279
       -
       

     

       280
       280
       -
         (** Request object as defined in RFC8620 Section 3.3.

     

       281
       281
       -
             Represents a JMAP request from client to server.

     

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

     

       283
       283
       -
         *)

     

       284
       284
       -
         type request = {

     

       285
       285
       -
           using: string list;  (** Capabilities required for this request *)

     

       286
       286
       -
           method_calls: Ezjsonm.value invocation list;  (** List of method calls to process *)

     

       287
       287
       -
           created_ids: (id * id) list option;  (** Map of client-created IDs to server IDs *)

     

       288
       288
       -
         }

     

       289
       289
       -
       

     

       290
       290
       -
         (** Response object as defined in RFC8620 Section 3.4.

     

       291
       291
       -
             Represents a JMAP response from server to client.

     

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

     

       293
       293
       -
         *)

     

       294
       294
       -
         type response = {

     

       295
       295
       -
           method_responses: Ezjsonm.value invocation list;  (** List of method responses *)

     

       296
       296
       -
           created_ids: (id * id) list option;  (** Map of client-created IDs to server IDs *)

     

       297
       297
       -
           session_state: string;  (** Current session state on the server *)

     

       298
       298
       -
         }

     

       299
       299
       -
       

     

       300
       300
       -
         (** {2 Standard method arguments and responses}

     

       301
       301
       -
             Standard method patterns defined in RFC8620 Section 5

     

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

     

       303
       303
       -
         *)

     

       304
       304
       -
       

     

       305
       305
       -
         (** Arguments for Foo/get method as defined in RFC8620 Section 5.1.

     

       306
       306
       -
             Generic template for retrieving objects by ID.

     

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

     

       308
       308
       -
         *)

     

       309
       309
       -
         type 'a get_arguments = {

     

       310
       310
       -
           account_id: id;  (** The account ID to operate on *)

     

       311
       311
       -
           ids: id list option;  (** IDs to fetch, null means all *)

     

       312
       312
       -
           properties: string list option;  (** Properties to return, null means all *)

     

       313
       313
       -
         }

     

       314
       314
       -
       

     

       315
       315
       -
         (** Response for Foo/get method as defined in RFC8620 Section 5.1.

     

       316
       316
       -
             Generic template for returning requested objects.

     

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

     

       318
       318
       -
         *)

     

       319
       319
       -
         type 'a get_response = {

     

       320
       320
       -
           account_id: id;  (** The account ID that was operated on *)

     

       321
       321
       -
           state: string;  (** Server state for the type at the time of processing *)

     

       322
       322
       -
           list: 'a list;  (** The list of requested objects *)

     

       323
       323
       -
           not_found: id list;  (** IDs that could not be found *)

     

       324
       324
       -
         }

     

       325
       325
       -
       

     

       326
       326
       -
         (** Arguments for Foo/changes method as defined in RFC8620 Section 5.2.

     

       327
       327
       -
             Generic template for getting state changes.

     

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

     

       329
       329
       -
         *)

     

       330
       330
       -
         type changes_arguments = {

     

       331
       331
       -
           account_id: id;  (** The account ID to operate on *)

     

       332
       332
       -
           since_state: string;  (** The last state seen by the client *)

     

       333
       333
       -
           max_changes: unsigned_int option;  (** Maximum number of changes to return *)

     

       334
       334
       -
         }

     

       335
       335
       -
       

     

       336
       336
       -
         (** Response for Foo/changes method as defined in RFC8620 Section 5.2.

     

       337
       337
       -
             Generic template for returning object changes.

     

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

     

       339
       339
       -
         *)

     

       340
       340
       -
         type changes_response = {

     

       341
       341
       -
           account_id: id;  (** The account ID that was operated on *)

     

       342
       342
       -
           old_state: string;  (** The state provided in the request *)

     

       343
       343
       -
           new_state: string;  (** The current server state *)

     

       344
       344
       -
           has_more_changes: bool;  (** True if more changes are available *)

     

       345
       345
       -
           created: id list;  (** IDs of objects created since old_state *)

     

       346
       346
       -
           updated: id list;  (** IDs of objects updated since old_state *)

     

       347
       347
       -
           destroyed: id list;  (** IDs of objects destroyed since old_state *)

     

       348
       348
       -
         }

     

       349
       349
       -
       

     

       350
       350
       -
         (** Arguments for Foo/set method as defined in RFC8620 Section 5.3.

     

       351
       351
       -
             Generic template for creating, updating, and destroying objects.

     

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

     

       353
       353
       -
         *)

     

       354
       354
       -
         type 'a set_arguments = {

     

       355
       355
       -
           account_id: id;  (** The account ID to operate on *)

     

       356
       356
       -
           if_in_state: string option;  (** Only apply changes if in this state *)

     

       357
       357
       -
           create: (id * 'a) list option;  (** Map of creation IDs to objects to create *)

     

       358
       358
       -
           update: (id * patch_object) list option;  (** Map of IDs to patches to apply *)

     

       359
       359
       -
           destroy: id list option;  (** List of IDs to destroy *)

     

       360
       360
       -
         }

     

       361
       361
       -
       

     

       362
       362
       -
         (** Response for Foo/set method as defined in RFC8620 Section 5.3.

     

       363
       363
       -
             Generic template for reporting create/update/destroy status.

     

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

     

       365
       365
       -
         *)

     

       366
       366
       -
         type 'a set_response = {

     

       367
       367
       -
           account_id: id;  (** The account ID that was operated on *)

     

       368
       368
       -
           old_state: string option;  (** The state before processing, if changed *)

     

       369
       369
       -
           new_state: string;  (** The current server state *)

     

       370
       370
       -
           created: (id * 'a) list option;  (** Map of creation IDs to created objects *)

     

       371
       371
       -
           updated: (id * 'a option) list option;  (** Map of IDs to updated objects *)

     

       372
       372
       -
           destroyed: id list option;  (** List of IDs successfully destroyed *)

     

       373
       373
       -
           not_created: (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       374
       374
       -
           not_updated: (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       375
       375
       -
           not_destroyed: (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       376
       376
       -
         }

     

       377
       377
       -
       

     

       378
       378
       -
         (** Arguments for Foo/copy method as defined in RFC8620 Section 5.4.

     

       379
       379
       -
             Generic template for copying objects between accounts.

     

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

     

       381
       381
       -
         *)

     

       382
       382
       -
         type 'a copy_arguments = {

     

       383
       383
       -
           from_account_id: id;  (** The account ID to copy from *)

     

       384
       384
       -
           if_from_in_state: string option;  (** Only copy if source account in this state *)

     

       385
       385
       -
           account_id: id;  (** The account ID to copy to *)

     

       386
       386
       -
           if_in_state: string option;  (** Only copy if destination account in this state *)

     

       387
       387
       -
           create: (id * 'a) list;  (** Map of creation IDs to objects to copy *)

     

       388
       388
       -
           on_success_destroy_original: bool option;  (** Whether to destroy the original after copying *)

     

       389
       389
       -
           destroy_from_if_in_state: string option;  (** Only destroy originals if in this state *)

     

       390
       390
       -
         }

     

       391
       391
       -
       

     

       392
       392
       -
         (** Response for Foo/copy method as defined in RFC8620 Section 5.4.

     

       393
       393
       -
             Generic template for reporting copy operation status.

     

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

     

       395
       395
       -
         *)

     

       396
       396
       -
         type 'a copy_response = {

     

       397
       397
       -
           from_account_id: id;  (** The account ID that was copied from *)

     

       398
       398
       -
           account_id: id;  (** The account ID that was copied to *)

     

       399
       399
       -
           old_state: string option;  (** The state before processing, if changed *)

     

       400
       400
       -
           new_state: string;  (** The current server state *)

     

       401
       401
       -
           created: (id * 'a) list option;  (** Map of creation IDs to created objects *)

     

       402
       402
       -
           not_created: (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       403
       403
       -
         }

     

       404
       404
       -
       

     

       405
       405
       -
         (** Arguments for Foo/query method as defined in RFC8620 Section 5.5.

     

       406
       406
       -
             Generic template for querying objects.

     

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

     

       408
       408
       -
         *)

     

       409
       409
       -
         type query_arguments = {

     

       410
       410
       -
           account_id: id;  (** The account ID to operate on *)

     

       411
       411
       -
           filter: filter option;  (** Filter to determine which objects are returned *)

     

       412
       412
       -
           sort: comparator list option;  (** Sort order for returned objects *)

     

       413
       413
       -
           position: int_t option;  (** Zero-based index of first result to return *)

     

       414
       414
       -
           anchor: id option;  (** ID of object to use as reference point *)

     

       415
       415
       -
           anchor_offset: int_t option;  (** Offset from anchor to start returning results *)

     

       416
       416
       -
           limit: unsigned_int option;  (** Maximum number of results to return *)

     

       417
       417
       -
           calculate_total: bool option;  (** Whether to calculate the total number of matching objects *)

     

       418
       418
       -
         }

     

       419
       419
       -
       

     

       420
       420
       -
         (** Response for Foo/query method as defined in RFC8620 Section 5.5.

     

       421
       421
       -
             Generic template for returning query results.

     

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

     

       423
       423
       -
         *)

     

       424
       424
       -
         type query_response = {

     

       425
       425
       -
           account_id: id;  (** The account ID that was operated on *)

     

       426
       426
       -
           query_state: string;  (** State string for the query results *)

     

       427
       427
       -
           can_calculate_changes: bool;  (** Whether queryChanges can be used with these results *)

     

       428
       428
       -
           position: unsigned_int;  (** Zero-based index of the first result *)

     

       429
       429
       -
           ids: id list;  (** The list of IDs for objects matching the query *)

     

       430
       430
       -
           total: unsigned_int option;  (** Total number of matching objects, if calculated *)

     

       431
       431
       -
           limit: unsigned_int option;  (** Limit enforced on the results, if requested *)

     

       432
       432
       -
         }

     

       433
       433
       -
       

     

       434
       434
       -
         (** Arguments for Foo/queryChanges method as defined in RFC8620 Section 5.6.

     

       435
       435
       -
             Generic template for getting query result changes.

     

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

     

       437
       437
       -
         *)

     

       438
       438
       -
         type query_changes_arguments = {

     

       439
       439
       -
           account_id: id;  (** The account ID to operate on *)

     

       440
       440
       -
           filter: filter option;  (** Same filter as used in the original query *)

     

       441
       441
       -
           sort: comparator list option;  (** Same sort as used in the original query *)

     

       442
       442
       -
           since_query_state: string;  (** The query_state from previous results *)

     

       443
       443
       -
           max_changes: unsigned_int option;  (** Maximum number of changes to return *)

     

       444
       444
       -
           up_to_id: id option;  (** Only calculate changes until this ID is encountered *)

     

       445
       445
       -
           calculate_total: bool option;  (** Whether to recalculate the total matches *)

     

       446
       446
       -
         }

     

       447
       447
       -
       

     

       448
       448
       -
         (** Response for Foo/queryChanges method as defined in RFC8620 Section 5.6.

     

       449
       449
       -
             Generic template for returning query result changes.

     

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

     

       451
       451
       -
         *)

     

       452
       452
       -
         type query_changes_response = {

     

       453
       453
       -
           account_id: id;  (** The account ID that was operated on *)

     

       454
       454
       -
           old_query_state: string;  (** The query_state from the request *)

     

       455
       455
       -
           new_query_state: string;  (** The current query_state on the server *)

     

       456
       456
       -
           total: unsigned_int option;  (** Updated total number of matches, if calculated *)

     

       457
       457
       -
           removed: id list;  (** IDs that were in the old results but not in the new *)

     

       458
       458
       -
           added: added_item list option;  (** IDs that are in the new results but not the old *)

     

       459
       459
       -
         }

     

       460
       460
       -
       

     

       461
       461
       -
         (** Arguments for Blob/copy method as defined in RFC8620 Section 6.3.

     

       462
       462
       -
             Used for copying binary data between accounts.

     

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

     

       464
       464
       -
         *)

     

       465
       465
       -
         type blob_copy_arguments = {

     

       466
       466
       -
           from_account_id: id;  (** The account ID to copy blobs from *)

     

       467
       467
       -
           account_id: id;  (** The account ID to copy blobs to *)

     

       468
       468
       -
           blob_ids: id list;  (** IDs of blobs to copy *)

     

       469
       469
       -
         }

     

       470
       470
       -
       

     

       471
       471
       -
         (** Response for Blob/copy method as defined in RFC8620 Section 6.3.

     

       472
       472
       -
             Reports the results of copying binary data.

     

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

     

       474
       474
       -
         *)

     

       475
       475
       -
         type blob_copy_response = {

     

       476
       476
       -
           from_account_id: id;  (** The account ID that was copied from *)

     

       477
       477
       -
           account_id: id;  (** The account ID that was copied to *)

     

       478
       478
       -
           copied: (id * id) list option;  (** Map of source IDs to destination IDs *)

     

       479
       479
       -
           not_copied: (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       480
       480
       -
         }

     

       481
       481
       -
       

     

       482
       482
       -
         (** Upload response as defined in RFC8620 Section 6.1.

     

       483
       483
       -
             Contains information about an uploaded binary blob.

     

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

     

       485
       485
       -
         *)

     

       486
       486
       -
         type upload_response = {

     

       487
       487
       -
           account_id: id;  (** The account ID the blob was uploaded to *)

     

       488
       488
       -
           blob_id: id;  (** The ID for the uploaded blob *)

     

       489
       489
       -
           type_: string;  (** Media type of the blob *)

     

       490
       490
       -
           size: unsigned_int;  (** Size of the blob in octets *)

     

       491
       491
       -
         }

     

       492
       492
       -
       

     

       493
       493
       -
         (** Problem details object as defined in RFC8620 Section 3.6.1 and RFC7807.

     

       494
       494
       -
             Used for HTTP error responses in the JMAP protocol.

     

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

     

       496
       496
       -
             @see <https://datatracker.ietf.org/doc/html/rfc7807>

     

       497
       497
       -
         *)

     

       498
       498
       -
         type problem_details = {

     

       499
       499
       -
           type_: string;  (** URI that identifies the problem type *)

     

       500
       500
       -
           status: int option;  (** HTTP status code for this problem *)

     

       501
       501
       -
           detail: string option;  (** Human-readable explanation of the problem *)

     

       502
       502
       -
           limit: string option;  (** For "limit" errors, which limit was exceeded *)

     

       503
       503
       -
         }

     

       504
       504
       -
       end

     

       505
       505
       -
       

     

       506
       506
       -
       (** {1 API Client}

     

       507
       507
       -
           Modules for interacting with JMAP servers

     

       508
       508
       -
       *)

     

       509
       509
       -
       

     

       510
       510
       -
       (** Module for working with ResultReferences as described in Section 3.7 of RFC8620.

     

       511
       511
       -
           Provides utilities to create and compose results from previous methods.

     

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

     

       513
       513
       -
       *)

     

       514
       514
       -
       module ResultReference : sig

     

       515
       515
       -
         (** Create a reference to a previous method result

     

       516
       516
       -
             @param result_of The methodCallId of the method call to reference

     

       517
       517
       -
             @param name The name in the response to reference (e.g., "list")

     

       518
       518
       -
             @param path JSON pointer path to the value being referenced

     

       519
       519
       -
             @return A result_reference object

     

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

     

       521
       521
       -
         *)

     

       522
       522
       -
         val create : 

     

       523
       523
       -
           result_of:string ->

     

       524
       524
       -
           name:string ->

     

       525
       525
       -
           path:string ->

     

       526
       526
       -
           Types.result_reference

     

       527
       527
       -
       

     

       528
       528
       -
         (** Create a JSON pointer path to access a specific property

     

       529
       529
       -
             @param property The property name to access

     

       530
       530
       -
             @return A JSON pointer path string

     

       531
       531
       -
         *)

     

       532
       532
       -
         val property_path : string -> string

     

       533
       533
       -
         

     

       534
       534
       -
         (** Create a JSON pointer path to access all items in an array with a specific property

     

       535
       535
       -
             @param property Optional property to access within each array item

     

       536
       536
       -
             @param array_name The name of the array to access

     

       537
       537
       -
             @return A JSON pointer path string that references all items in the array

     

       538
       538
       -
         *)

     

       539
       539
       -
         val array_items_path : ?property:string -> string -> string

     

       540
       540
       -
         

     

       541
       541
       -
         (** Create argument with result reference.

     

       542
       542
       -
             @param arg_name The name of the argument

     

       543
       543
       -
             @param reference The result reference to use

     

       544
       544
       -
             @return A tuple of string key (with # prefix) and ResultReference JSON value

     

       545
       545
       -
         *)

     

       546
       546
       -
         val reference_arg : string -> Types.result_reference -> string * Ezjsonm.value

     

       547
       547
       -
         

     

       548
       548
       -
         (** Create a reference to all IDs returned by a query method

     

       549
       549
       -
             @param result_of The methodCallId of the query method call

     

       550
       550
       -
             @return A result_reference to the IDs returned by the query

     

       551
       551
       -
         *)

     

       552
       552
       -
         val query_ids :

     

       553
       553
       -
           result_of:string ->

     

       554
       554
       -
           Types.result_reference

     

       555
       555
       -
           

     

       556
       556
       -
         (** Create a reference to properties of objects returned by a get method

     

       557
       557
       -
             @param result_of The methodCallId of the get method call

     

       558
       558
       -
             @param property The property to reference in the returned objects

     

       559
       559
       -
             @return A result_reference to the specified property in the get results

     

       560
       560
       -
         *)

     

       561
       561
       -
         val get_property :

     

       562
       562
       -
           result_of:string ->

     

       563
       563
       -
           property:string ->

     

       564
       564
       -
           Types.result_reference

     

       565
       565
       -
       end

     

       566
       566
       -
       

     

       567
       567
       -
       (** Module for making JMAP API requests over HTTP.

     

       568
       568
       -
           Provides functionality to interact with JMAP servers according to RFC8620.

     

       569
       569
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8620>

     

       570
       570
       -
       *)

     

       571
       571
       -
       module Api : sig

     

       572
       572
       -
         (** Error that may occur during API requests *)

     

       573
       573
       -
         type error =

     

       574
       574
       -
           | Connection_error of string   (** Network-related errors *)

     

       575
       575
       -
           | HTTP_error of int * string   (** HTTP errors with status code and message *)

     

       576
       576
       -
           | Parse_error of string        (** JSON parsing errors *)

     

       577
       577
       -
           | Authentication_error         (** Authentication failures *)

     

       578
       578
       -
         

     

       579
       579
       -
         (** Result type for API operations *)

     

       580
       580
       -
         type 'a result = ('a, error) Stdlib.result

     

       581
       581
       -
         

     

       582
       582
       -
         (** Convert an error to a human-readable string 

     

       583
       583
       -
             @param err The error to convert

     

       584
       584
       -
             @return A string representation of the error

     

       585
       585
       -
         *)

     

       586
       586
       -
         val string_of_error : error -> string

     

       587
       587
       -
         

     

       588
       588
       -
         (** Pretty-print an error to a formatter

     

       589
       589
       -
             @param ppf The formatter to print to

     

       590
       590
       -
             @param err The error to print

     

       591
       591
       -
         *)

     

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

     

       593
       593
       -
         

     

       594
       594
       -
         (** Configuration for a JMAP API client as defined in RFC8620 Section 3.1

     

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

     

       596
       596
       -
         *)

     

       597
       597
       -
         type config = {

     

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

     

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

     

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

     

       601
       601
       -
         }

     

       602
       602
       -
         

     

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

     

       604
       604
       -
             @param config The API client configuration

     

       605
       605
       -
             @param request The JMAP request to send

     

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

     

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

     

       608
       608
       -
         *)

     

       609
       609
       -
         val make_request : 

     

       610
       610
       -
           config -> 

     

       611
       611
       -
           Types.request ->

     

       612
       612
       -
           Types.response result Lwt.t

     

       613
       613
       -
         

     

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

     

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

     

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

     

       617
       617
       -
             @param username Optional username for authentication

     

       618
       618
       -
             @param authentication_token Optional password or token for authentication

     

       619
       619
       -
             @param api_token Optional API token for Bearer authentication

     

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

     

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

     

       622
       622
       -
         *)

     

       623
       623
       -
         val get_session :

     

       624
       624
       -
           Uri.t ->

     

       625
       625
       -
           ?username:string ->

     

       626
       626
       -
           ?authentication_token:string ->

     

       627
       627
       -
           ?api_token:string ->

     

       628
       628
       -
           unit ->

     

       629
       629
       -
           Types.session result Lwt.t

     

       630
       630
       -
         

     

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

     

       632
       632
       -
             @param config The API client configuration

     

       633
       633
       -
             @param account_id The account ID to upload to

     

       634
       634
       -
             @param content_type The MIME type of the blob

     

       635
       635
       -
             @param data The blob data as a string

     

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

     

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

     

       638
       638
       -
         *)

     

       639
       639
       -
         val upload_blob :

     

       640
       640
       -
           config ->

     

       641
       641
       -
           account_id:Types.id ->

     

       642
       642
       -
           content_type:string ->

     

       643
       643
       -
           string ->

     

       644
       644
       -
           Types.upload_response result Lwt.t

     

       645
       645
       -
         

     

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

     

       647
       647
       -
             @param config The API client configuration

     

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

     

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

     

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

     

       651
       651
       -
             @param name Optional name for the downloaded blob

     

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

     

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

     

       654
       654
       -
         *)

     

       655
       655
       -
         val download_blob :

     

       656
       656
       -
           config ->

     

       657
       657
       -
           account_id:Types.id ->

     

       658
       658
       -
           blob_id:Types.id ->

     

       659
       659
       -
           ?type_:string ->

     

       660
       660
       -
           ?name:string ->

     

       661
       661
       -
           unit ->

     

       662
       662
       -
           string result Lwt.t

     

       663
       663
       -
       end

-2828

lib/jmap_mail.ml

···

       1
       1
       -
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 *)

     

       2
       2
       -
       

     

       3
       3
       -
       (** Module for managing JMAP Mail-specific capability URIs *)

     

       4
       4
       -
       module Capability = struct

     

       5
       5
       -
         (** Mail capability URI *)

     

       6
       6
       -
         let mail_uri = "urn:ietf:params:jmap:mail"

     

       7
       7
       -
       

     

       8
       8
       -
         (** Submission capability URI *)

     

       9
       9
       -
         let submission_uri = "urn:ietf:params:jmap:submission"

     

       10
       10
       -
       

     

       11
       11
       -
         (** Vacation response capability URI *)

     

       12
       12
       -
         let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"

     

       13
       13
       -
       

     

       14
       14
       -
         (** All mail extension capability types *)

     

       15
       15
       -
         type t =

     

       16
       16
       -
           | Mail            (** Mail capability *)

     

       17
       17
       -
           | Submission      (** Submission capability *)

     

       18
       18
       -
           | VacationResponse (** Vacation response capability *)

     

       19
       19
       -
           | Extension of string (** Custom extension *)

     

       20
       20
       -
       

     

       21
       21
       -
         (** Convert capability to URI string *)

     

       22
       22
       -
         let to_string = function

     

       23
       23
       -
           | Mail -> mail_uri

     

       24
       24
       -
           | Submission -> submission_uri

     

       25
       25
       -
           | VacationResponse -> vacation_response_uri

     

       26
       26
       -
           | Extension s -> s

     

       27
       27
       -
       

     

       28
       28
       -
         (** Parse a string to a capability *)

     

       29
       29
       -
         let of_string s =

     

       30
       30
       -
           if s = mail_uri then Mail

     

       31
       31
       -
           else if s = submission_uri then Submission

     

       32
       32
       -
           else if s = vacation_response_uri then VacationResponse

     

       33
       33
       -
           else Extension s

     

       34
       34
       -
       

     

       35
       35
       -
         (** Check if a capability is a standard mail capability *)

     

       36
       36
       -
         let is_standard = function

     

       37
       37
       -
           | Mail | Submission | VacationResponse -> true

     

       38
       38
       -
           | Extension _ -> false

     

       39
       39
       -
       

     

       40
       40
       -
         (** Check if a capability string is a standard mail capability *)

     

       41
       41
       -
         let is_standard_string s =

     

       42
       42
       -
           s = mail_uri || s = submission_uri || s = vacation_response_uri

     

       43
       43
       -
       

     

       44
       44
       -
         (** Create a list of capability strings *)

     

       45
       45
       -
         let strings_of_capabilities capabilities =

     

       46
       46
       -
           List.map to_string capabilities

     

       47
       47
       -
       end

     

       48
       48
       -
       

     

       49
       49
       -
       module Types = struct

     

       50
       50
       -
         open Jmap.Types

     

       51
       51
       -
       

     

       52
       52
       -
         (** {1 Mail capabilities} *)

     

       53
       53
       -
       

     

       54
       54
       -
         (** Capability URI for JMAP Mail*)

     

       55
       55
       -
         let capability_mail = Capability.mail_uri

     

       56
       56
       -
       

     

       57
       57
       -
         (** Capability URI for JMAP Submission *)

     

       58
       58
       -
         let capability_submission = Capability.submission_uri

     

       59
       59
       -
         

     

       60
       60
       -
         (** Capability URI for JMAP Vacation Response *)

     

       61
       61
       -
         let capability_vacation_response = Capability.vacation_response_uri

     

       62
       62
       -
       

     

       63
       63
       -
         (** {1:mailbox Mailbox objects} *)

     

       64
       64
       -
       

     

       65
       65
       -
         (** A role for a mailbox. See RFC8621 Section 2. *)

     

       66
       66
       -
         type mailbox_role =

     

       67
       67
       -
           | All (** All mail *)

     

       68
       68
       -
           | Archive (** Archived mail *)

     

       69
       69
       -
           | Drafts (** Draft messages *)

     

       70
       70
       -
           | Flagged (** Starred/flagged mail *)

     

       71
       71
       -
           | Important (** Important mail *)

     

       72
       72
       -
           | Inbox (** Inbox *)

     

       73
       73
       -
           | Junk (** Spam/Junk mail *)

     

       74
       74
       -
           | Sent (** Sent mail *)

     

       75
       75
       -
           | Trash (** Deleted/Trash mail *)

     

       76
       76
       -
           | Unknown of string (** Server-specific roles *)

     

       77
       77
       -
         

     

       78
       78
       -
         (** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)

     

       79
       79
       -
         type mailbox = {

     

       80
       80
       -
           id : id;

     

       81
       81
       -
           name : string;

     

       82
       82
       -
           parent_id : id option;

     

       83
       83
       -
           role : mailbox_role option;

     

       84
       84
       -
           sort_order : unsigned_int;

     

       85
       85
       -
           total_emails : unsigned_int;

     

       86
       86
       -
           unread_emails : unsigned_int;

     

       87
       87
       -
           total_threads : unsigned_int;

     

       88
       88
       -
           unread_threads : unsigned_int;

     

       89
       89
       -
           is_subscribed : bool;

     

       90
       90
       -
           my_rights : mailbox_rights;

     

       91
       91
       -
         }

     

       92
       92
       -
       

     

       93
       93
       -
         (** Rights for a mailbox. See RFC8621 Section 2. *)

     

       94
       94
       -
         and mailbox_rights = {

     

       95
       95
       -
           may_read_items : bool;

     

       96
       96
       -
           may_add_items : bool;

     

       97
       97
       -
           may_remove_items : bool;

     

       98
       98
       -
           may_set_seen : bool;

     

       99
       99
       -
           may_set_keywords : bool;

     

       100
       100
       -
           may_create_child : bool;

     

       101
       101
       -
           may_rename : bool;

     

       102
       102
       -
           may_delete : bool;

     

       103
       103
       -
           may_submit : bool;

     

       104
       104
       -
         }

     

       105
       105
       -
       

     

       106
       106
       -
         (** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)

     

       107
       107
       -
         type mailbox_filter_condition = {

     

       108
       108
       -
           parent_id : id option;

     

       109
       109
       -
           name : string option;

     

       110
       110
       -
           role : string option;

     

       111
       111
       -
           has_any_role : bool option;

     

       112
       112
       -
           is_subscribed : bool option;

     

       113
       113
       -
         }

     

       114
       114
       -
       

     

       115
       115
       -
         type mailbox_query_filter = [

     

       116
       116
       -
           | `And of mailbox_query_filter list

     

       117
       117
       -
           | `Or of mailbox_query_filter list

     

       118
       118
       -
           | `Not of mailbox_query_filter

     

       119
       119
       -
           | `Condition of mailbox_filter_condition

     

       120
       120
       -
         ]

     

       121
       121
       -
       

     

       122
       122
       -
         (** Mailbox/get request arguments. See RFC8621 Section 2.1. *)

     

       123
       123
       -
         type mailbox_get_arguments = {

     

       124
       124
       -
           account_id : id;

     

       125
       125
       -
           ids : id list option;

     

       126
       126
       -
           properties : string list option;

     

       127
       127
       -
         }

     

       128
       128
       -
       

     

       129
       129
       -
         (** Mailbox/get response. See RFC8621 Section 2.1. *)

     

       130
       130
       -
         type mailbox_get_response = {

     

       131
       131
       -
           account_id : id;

     

       132
       132
       -
           state : string;

     

       133
       133
       -
           list : mailbox list;

     

       134
       134
       -
           not_found : id list;

     

       135
       135
       -
         }

     

       136
       136
       -
       

     

       137
       137
       -
         (** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)

     

       138
       138
       -
         type mailbox_changes_arguments = {

     

       139
       139
       -
           account_id : id;

     

       140
       140
       -
           since_state : string;

     

       141
       141
       -
           max_changes : unsigned_int option;

     

       142
       142
       -
         }

     

       143
       143
       -
       

     

       144
       144
       -
         (** Mailbox/changes response. See RFC8621 Section 2.2. *)

     

       145
       145
       -
         type mailbox_changes_response = {

     

       146
       146
       -
           account_id : id;

     

       147
       147
       -
           old_state : string;

     

       148
       148
       -
           new_state : string;

     

       149
       149
       -
           has_more_changes : bool;

     

       150
       150
       -
           created : id list;

     

       151
       151
       -
           updated : id list;

     

       152
       152
       -
           destroyed : id list;

     

       153
       153
       -
         }

     

       154
       154
       -
       

     

       155
       155
       -
         (** Mailbox/query request arguments. See RFC8621 Section 2.3. *)

     

       156
       156
       -
         type mailbox_query_arguments = {

     

       157
       157
       -
           account_id : id;

     

       158
       158
       -
           filter : mailbox_query_filter option;

     

       159
       159
       -
           sort : [ `name | `role | `sort_order ] list option;

     

       160
       160
       -
           limit : unsigned_int option;

     

       161
       161
       -
         }

     

       162
       162
       -
       

     

       163
       163
       -
         (** Mailbox/query response. See RFC8621 Section 2.3. *)

     

       164
       164
       -
         type mailbox_query_response = {

     

       165
       165
       -
           account_id : id;

     

       166
       166
       -
           query_state : string;

     

       167
       167
       -
           can_calculate_changes : bool;

     

       168
       168
       -
           position : unsigned_int;

     

       169
       169
       -
           ids : id list;

     

       170
       170
       -
           total : unsigned_int option;

     

       171
       171
       -
         }

     

       172
       172
       -
       

     

       173
       173
       -
         (** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)

     

       174
       174
       -
         type mailbox_query_changes_arguments = {

     

       175
       175
       -
           account_id : id;

     

       176
       176
       -
           filter : mailbox_query_filter option;

     

       177
       177
       -
           sort : [ `name | `role | `sort_order ] list option;

     

       178
       178
       -
           since_query_state : string;

     

       179
       179
       -
           max_changes : unsigned_int option;

     

       180
       180
       -
           up_to_id : id option;

     

       181
       181
       -
         }

     

       182
       182
       -
       

     

       183
       183
       -
         (** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)

     

       184
       184
       -
         type mailbox_query_changes_response = {

     

       185
       185
       -
           account_id : id;

     

       186
       186
       -
           old_query_state : string;

     

       187
       187
       -
           new_query_state : string;

     

       188
       188
       -
           total : unsigned_int option;

     

       189
       189
       -
           removed : id list;

     

       190
       190
       -
           added : mailbox_query_changes_added list;

     

       191
       191
       -
         }

     

       192
       192
       -
       

     

       193
       193
       -
         and mailbox_query_changes_added = {

     

       194
       194
       -
           id : id;

     

       195
       195
       -
           index : unsigned_int;

     

       196
       196
       -
         }

     

       197
       197
       -
       

     

       198
       198
       -
         (** Mailbox/set request arguments. See RFC8621 Section 2.5. *)

     

       199
       199
       -
         type mailbox_set_arguments = {

     

       200
       200
       -
           account_id : id;

     

       201
       201
       -
           if_in_state : string option;

     

       202
       202
       -
           create : (id * mailbox_creation) list option;

     

       203
       203
       -
           update : (id * mailbox_update) list option;

     

       204
       204
       -
           destroy : id list option;

     

       205
       205
       -
         }

     

       206
       206
       -
       

     

       207
       207
       -
         and mailbox_creation = {

     

       208
       208
       -
           name : string;

     

       209
       209
       -
           parent_id : id option;

     

       210
       210
       -
           role : string option;

     

       211
       211
       -
           sort_order : unsigned_int option;

     

       212
       212
       -
           is_subscribed : bool option;

     

       213
       213
       -
         }

     

       214
       214
       -
       

     

       215
       215
       -
         and mailbox_update = {

     

       216
       216
       -
           name : string option;

     

       217
       217
       -
           parent_id : id option;

     

       218
       218
       -
           role : string option;

     

       219
       219
       -
           sort_order : unsigned_int option;

     

       220
       220
       -
           is_subscribed : bool option;

     

       221
       221
       -
         }

     

       222
       222
       -
       

     

       223
       223
       -
         (** Mailbox/set response. See RFC8621 Section 2.5. *)

     

       224
       224
       -
         type mailbox_set_response = {

     

       225
       225
       -
           account_id : id;

     

       226
       226
       -
           old_state : string option;

     

       227
       227
       -
           new_state : string;

     

       228
       228
       -
           created : (id * mailbox) list option;

     

       229
       229
       -
           updated : id list option;

     

       230
       230
       -
           destroyed : id list option;

     

       231
       231
       -
           not_created : (id * set_error) list option;

     

       232
       232
       -
           not_updated : (id * set_error) list option;

     

       233
       233
       -
           not_destroyed : (id * set_error) list option;

     

       234
       234
       -
         }

     

       235
       235
       -
       

     

       236
       236
       -
         (** {1:thread Thread objects} *)

     

       237
       237
       -
       

     

       238
       238
       -
         (** A thread in a mail account. See RFC8621 Section 3. *)

     

       239
       239
       -
         type thread = {

     

       240
       240
       -
           id : id;

     

       241
       241
       -
           email_ids : id list;

     

       242
       242
       -
         }

     

       243
       243
       -
       

     

       244
       244
       -
         (** Thread/get request arguments. See RFC8621 Section 3.1. *)

     

       245
       245
       -
         type thread_get_arguments = {

     

       246
       246
       -
           account_id : id;

     

       247
       247
       -
           ids : id list option;

     

       248
       248
       -
           properties : string list option;

     

       249
       249
       -
         }

     

       250
       250
       -
       

     

       251
       251
       -
         (** Thread/get response. See RFC8621 Section 3.1. *)

     

       252
       252
       -
         type thread_get_response = {

     

       253
       253
       -
           account_id : id;

     

       254
       254
       -
           state : string;

     

       255
       255
       -
           list : thread list;

     

       256
       256
       -
           not_found : id list;

     

       257
       257
       -
         }

     

       258
       258
       -
       

     

       259
       259
       -
         (** Thread/changes request arguments. See RFC8621 Section 3.2. *)

     

       260
       260
       -
         type thread_changes_arguments = {

     

       261
       261
       -
           account_id : id;

     

       262
       262
       -
           since_state : string;

     

       263
       263
       -
           max_changes : unsigned_int option;

     

       264
       264
       -
         }

     

       265
       265
       -
       

     

       266
       266
       -
         (** Thread/changes response. See RFC8621 Section 3.2. *)

     

       267
       267
       -
         type thread_changes_response = {

     

       268
       268
       -
           account_id : id;

     

       269
       269
       -
           old_state : string;

     

       270
       270
       -
           new_state : string;

     

       271
       271
       -
           has_more_changes : bool;

     

       272
       272
       -
           created : id list;

     

       273
       273
       -
           updated : id list;

     

       274
       274
       -
           destroyed : id list;

     

       275
       275
       -
         }

     

       276
       276
       -
       

     

       277
       277
       -
         (** {1:email Email objects} *)

     

       278
       278
       -
       

     

       279
       279
       -
         (** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)

     

       280
       280
       -
         type email_address = {

     

       281
       281
       -
           name : string option;

     

       282
       282
       -
           email : string;

     

       283
       283
       -
           parameters : (string * string) list;

     

       284
       284
       -
         }

     

       285
       285
       -
       

     

       286
       286
       -
         (** Message header field. See RFC8621 Section 4.1.2. *)

     

       287
       287
       -
         type header = {

     

       288
       288
       -
           name : string;

     

       289
       289
       -
           value : string;

     

       290
       290
       -
         }

     

       291
       291
       -
       

     

       292
       292
       -
         (** Email keyword (flag). See RFC8621 Section 4.3. *)

     

       293
       293
       -
         type keyword =

     

       294
       294
       -
           | Flagged

     

       295
       295
       -
           | Answered

     

       296
       296
       -
           | Draft

     

       297
       297
       -
           | Forwarded

     

       298
       298
       -
           | Phishing

     

       299
       299
       -
           | Junk

     

       300
       300
       -
           | NotJunk

     

       301
       301
       -
           | Seen

     

       302
       302
       -
           | Unread

     

       303
       303
       -
           | Custom of string

     

       304
       304
       -
         

     

       305
       305
       -
         (** Email message. See RFC8621 Section 4. *)

     

       306
       306
       -
         type email = {

     

       307
       307
       -
           id : id;

     

       308
       308
       -
           blob_id : id;

     

       309
       309
       -
           thread_id : id;

     

       310
       310
       -
           mailbox_ids : (id * bool) list;

     

       311
       311
       -
           keywords : (keyword * bool) list;

     

       312
       312
       -
           size : unsigned_int;

     

       313
       313
       -
           received_at : utc_date;

     

       314
       314
       -
           message_id : string list;

     

       315
       315
       -
           in_reply_to : string list option;

     

       316
       316
       -
           references : string list option;

     

       317
       317
       -
           sender : email_address list option;

     

       318
       318
       -
           from : email_address list option;

     

       319
       319
       -
           to_ : email_address list option;

     

       320
       320
       -
           cc : email_address list option;

     

       321
       321
       -
           bcc : email_address list option;

     

       322
       322
       -
           reply_to : email_address list option;

     

       323
       323
       -
           subject : string option;

     

       324
       324
       -
           sent_at : utc_date option;

     

       325
       325
       -
           has_attachment : bool option;

     

       326
       326
       -
           preview : string option;

     

       327
       327
       -
           body_values : (string * string) list option;

     

       328
       328
       -
           text_body : email_body_part list option;

     

       329
       329
       -
           html_body : email_body_part list option;

     

       330
       330
       -
           attachments : email_body_part list option;

     

       331
       331
       -
           headers : header list option;

     

       332
       332
       -
         }

     

       333
       333
       -
       

     

       334
       334
       -
         (** Email body part. See RFC8621 Section 4.1.4. *)

     

       335
       335
       -
         and email_body_part = {

     

       336
       336
       -
           part_id : string option;

     

       337
       337
       -
           blob_id : id option;

     

       338
       338
       -
           size : unsigned_int option;

     

       339
       339
       -
           headers : header list option;

     

       340
       340
       -
           name : string option;

     

       341
       341
       -
           type_ : string option;

     

       342
       342
       -
           charset : string option;

     

       343
       343
       -
           disposition : string option;

     

       344
       344
       -
           cid : string option;

     

       345
       345
       -
           language : string list option;

     

       346
       346
       -
           location : string option;

     

       347
       347
       -
           sub_parts : email_body_part list option;

     

       348
       348
       -
           header_parameter_name : string option;

     

       349
       349
       -
           header_parameter_value : string option;

     

       350
       350
       -
         }

     

       351
       351
       -
         

     

       352
       352
       -
         (** Email query filter condition. See RFC8621 Section 4.4. *)

     

       353
       353
       -
         type email_filter_condition = {

     

       354
       354
       -
           in_mailbox : id option;

     

       355
       355
       -
           in_mailbox_other_than : id list option;

     

       356
       356
       -
           min_size : unsigned_int option;

     

       357
       357
       -
           max_size : unsigned_int option;

     

       358
       358
       -
           before : utc_date option;

     

       359
       359
       -
           after : utc_date option;

     

       360
       360
       -
           header : (string * string) option;

     

       361
       361
       -
           from : string option;

     

       362
       362
       -
           to_ : string option;

     

       363
       363
       -
           cc : string option;

     

       364
       364
       -
           bcc : string option;

     

       365
       365
       -
           subject : string option;

     

       366
       366
       -
           body : string option;

     

       367
       367
       -
           has_keyword : string option;

     

       368
       368
       -
           not_keyword : string option;

     

       369
       369
       -
           has_attachment : bool option;

     

       370
       370
       -
           text : string option;

     

       371
       371
       -
         }

     

       372
       372
       -
       

     

       373
       373
       -
         type email_query_filter = [

     

       374
       374
       -
           | `And of email_query_filter list

     

       375
       375
       -
           | `Or of email_query_filter list

     

       376
       376
       -
           | `Not of email_query_filter

     

       377
       377
       -
           | `Condition of email_filter_condition

     

       378
       378
       -
         ]

     

       379
       379
       -
       

     

       380
       380
       -
         (** Email/get request arguments. See RFC8621 Section 4.5. *)

     

       381
       381
       -
         type email_get_arguments = {

     

       382
       382
       -
           account_id : id;

     

       383
       383
       -
           ids : id list option;

     

       384
       384
       -
           properties : string list option;

     

       385
       385
       -
           body_properties : string list option;

     

       386
       386
       -
           fetch_text_body_values : bool option;

     

       387
       387
       -
           fetch_html_body_values : bool option;

     

       388
       388
       -
           fetch_all_body_values : bool option;

     

       389
       389
       -
           max_body_value_bytes : unsigned_int option;

     

       390
       390
       -
         }

     

       391
       391
       -
       

     

       392
       392
       -
         (** Email/get response. See RFC8621 Section 4.5. *)

     

       393
       393
       -
         type email_get_response = {

     

       394
       394
       -
           account_id : id;

     

       395
       395
       -
           state : string;

     

       396
       396
       -
           list : email list;

     

       397
       397
       -
           not_found : id list;

     

       398
       398
       -
         }

     

       399
       399
       -
       

     

       400
       400
       -
         (** Email/changes request arguments. See RFC8621 Section 4.6. *)

     

       401
       401
       -
         type email_changes_arguments = {

     

       402
       402
       -
           account_id : id;

     

       403
       403
       -
           since_state : string;

     

       404
       404
       -
           max_changes : unsigned_int option;

     

       405
       405
       -
         }

     

       406
       406
       -
       

     

       407
       407
       -
         (** Email/changes response. See RFC8621 Section 4.6. *)

     

       408
       408
       -
         type email_changes_response = {

     

       409
       409
       -
           account_id : id;

     

       410
       410
       -
           old_state : string;

     

       411
       411
       -
           new_state : string;

     

       412
       412
       -
           has_more_changes : bool;

     

       413
       413
       -
           created : id list;

     

       414
       414
       -
           updated : id list;

     

       415
       415
       -
           destroyed : id list;

     

       416
       416
       -
         }

     

       417
       417
       -
       

     

       418
       418
       -
         (** Email/query request arguments. See RFC8621 Section 4.4. *)

     

       419
       419
       -
         type email_query_arguments = {

     

       420
       420
       -
           account_id : id;

     

       421
       421
       -
           filter : email_query_filter option;

     

       422
       422
       -
           sort : comparator list option;

     

       423
       423
       -
           collapse_threads : bool option;

     

       424
       424
       -
           position : unsigned_int option;

     

       425
       425
       -
           anchor : id option;

     

       426
       426
       -
           anchor_offset : int_t option;

     

       427
       427
       -
           limit : unsigned_int option;

     

       428
       428
       -
           calculate_total : bool option;

     

       429
       429
       -
         }

     

       430
       430
       -
       

     

       431
       431
       -
         (** Email/query response. See RFC8621 Section 4.4. *)

     

       432
       432
       -
         type email_query_response = {

     

       433
       433
       -
           account_id : id;

     

       434
       434
       -
           query_state : string;

     

       435
       435
       -
           can_calculate_changes : bool;

     

       436
       436
       -
           position : unsigned_int;

     

       437
       437
       -
           ids : id list;

     

       438
       438
       -
           total : unsigned_int option;

     

       439
       439
       -
           thread_ids : id list option;

     

       440
       440
       -
         }

     

       441
       441
       -
       

     

       442
       442
       -
         (** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)

     

       443
       443
       -
         type email_query_changes_arguments = {

     

       444
       444
       -
           account_id : id;

     

       445
       445
       -
           filter : email_query_filter option;

     

       446
       446
       -
           sort : comparator list option;

     

       447
       447
       -
           collapse_threads : bool option;

     

       448
       448
       -
           since_query_state : string;

     

       449
       449
       -
           max_changes : unsigned_int option;

     

       450
       450
       -
           up_to_id : id option;

     

       451
       451
       -
         }

     

       452
       452
       -
       

     

       453
       453
       -
         (** Email/queryChanges response. See RFC8621 Section 4.7. *)

     

       454
       454
       -
         type email_query_changes_response = {

     

       455
       455
       -
           account_id : id;

     

       456
       456
       -
           old_query_state : string;

     

       457
       457
       -
           new_query_state : string;

     

       458
       458
       -
           total : unsigned_int option;

     

       459
       459
       -
           removed : id list;

     

       460
       460
       -
           added : email_query_changes_added list;

     

       461
       461
       -
         }

     

       462
       462
       -
       

     

       463
       463
       -
         and email_query_changes_added = {

     

       464
       464
       -
           id : id;

     

       465
       465
       -
           index : unsigned_int;

     

       466
       466
       -
         }

     

       467
       467
       -
       

     

       468
       468
       -
         (** Email/set request arguments. See RFC8621 Section 4.8. *)

     

       469
       469
       -
         type email_set_arguments = {

     

       470
       470
       -
           account_id : id;

     

       471
       471
       -
           if_in_state : string option;

     

       472
       472
       -
           create : (id * email_creation) list option;

     

       473
       473
       -
           update : (id * email_update) list option;

     

       474
       474
       -
           destroy : id list option;

     

       475
       475
       -
         }

     

       476
       476
       -
       

     

       477
       477
       -
         and email_creation = {

     

       478
       478
       -
           mailbox_ids : (id * bool) list;

     

       479
       479
       -
           keywords : (keyword * bool) list option;

     

       480
       480
       -
           received_at : utc_date option;

     

       481
       481
       -
           message_id : string list option;

     

       482
       482
       -
           in_reply_to : string list option;

     

       483
       483
       -
           references : string list option;

     

       484
       484
       -
           sender : email_address list option;

     

       485
       485
       -
           from : email_address list option;

     

       486
       486
       -
           to_ : email_address list option;

     

       487
       487
       -
           cc : email_address list option;

     

       488
       488
       -
           bcc : email_address list option;

     

       489
       489
       -
           reply_to : email_address list option;

     

       490
       490
       -
           subject : string option;

     

       491
       491
       -
           body_values : (string * string) list option;

     

       492
       492
       -
           text_body : email_body_part list option;

     

       493
       493
       -
           html_body : email_body_part list option;

     

       494
       494
       -
           attachments : email_body_part list option;

     

       495
       495
       -
           headers : header list option;

     

       496
       496
       -
         }

     

       497
       497
       -
       

     

       498
       498
       -
         and email_update = {

     

       499
       499
       -
           keywords : (keyword * bool) list option;

     

       500
       500
       -
           mailbox_ids : (id * bool) list option;

     

       501
       501
       -
         }

     

       502
       502
       -
       

     

       503
       503
       -
         (** Email/set response. See RFC8621 Section 4.8. *)

     

       504
       504
       -
         type email_set_response = {

     

       505
       505
       -
           account_id : id;

     

       506
       506
       -
           old_state : string option;

     

       507
       507
       -
           new_state : string;

     

       508
       508
       -
           created : (id * email) list option;

     

       509
       509
       -
           updated : id list option;

     

       510
       510
       -
           destroyed : id list option;

     

       511
       511
       -
           not_created : (id * set_error) list option;

     

       512
       512
       -
           not_updated : (id * set_error) list option;

     

       513
       513
       -
           not_destroyed : (id * set_error) list option;

     

       514
       514
       -
         }

     

       515
       515
       -
       

     

       516
       516
       -
         (** Email/copy request arguments. See RFC8621 Section 4.9. *)

     

       517
       517
       -
         type email_copy_arguments = {

     

       518
       518
       -
           from_account_id : id;

     

       519
       519
       -
           account_id : id;

     

       520
       520
       -
           create : (id * email_creation) list;

     

       521
       521
       -
           on_success_destroy_original : bool option;

     

       522
       522
       -
         }

     

       523
       523
       -
       

     

       524
       524
       -
         (** Email/copy response. See RFC8621 Section 4.9. *)

     

       525
       525
       -
         type email_copy_response = {

     

       526
       526
       -
           from_account_id : id;

     

       527
       527
       -
           account_id : id;

     

       528
       528
       -
           created : (id * email) list option;

     

       529
       529
       -
           not_created : (id * set_error) list option;

     

       530
       530
       -
         }

     

       531
       531
       -
       

     

       532
       532
       -
         (** Email/import request arguments. See RFC8621 Section 4.10. *)

     

       533
       533
       -
         type email_import_arguments = {

     

       534
       534
       -
           account_id : id;

     

       535
       535
       -
           emails : (id * email_import) list;

     

       536
       536
       -
         }

     

       537
       537
       -
       

     

       538
       538
       -
         and email_import = {

     

       539
       539
       -
           blob_id : id;

     

       540
       540
       -
           mailbox_ids : (id * bool) list;

     

       541
       541
       -
           keywords : (keyword * bool) list option;

     

       542
       542
       -
           received_at : utc_date option;

     

       543
       543
       -
         }

     

       544
       544
       -
       

     

       545
       545
       -
         (** Email/import response. See RFC8621 Section 4.10. *)

     

       546
       546
       -
         type email_import_response = {

     

       547
       547
       -
           account_id : id;

     

       548
       548
       -
           created : (id * email) list option;

     

       549
       549
       -
           not_created : (id * set_error) list option;

     

       550
       550
       -
         }

     

       551
       551
       -
       

     

       552
       552
       -
         (** {1:search_snippet Search snippets} *)

     

       553
       553
       -
       

     

       554
       554
       -
         (** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)

     

       555
       555
       -
         type search_snippet_get_arguments = {

     

       556
       556
       -
           account_id : id;

     

       557
       557
       -
           email_ids : id list;

     

       558
       558
       -
           filter : email_filter_condition;

     

       559
       559
       -
         }

     

       560
       560
       -
       

     

       561
       561
       -
         (** SearchSnippet/get response. See RFC8621 Section 4.11. *)

     

       562
       562
       -
         type search_snippet_get_response = {

     

       563
       563
       -
           account_id : id;

     

       564
       564
       -
           list : (id * search_snippet) list;

     

       565
       565
       -
           not_found : id list;

     

       566
       566
       -
         }

     

       567
       567
       -
       

     

       568
       568
       -
         and search_snippet = {

     

       569
       569
       -
           subject : string option;

     

       570
       570
       -
           preview : string option;

     

       571
       571
       -
         }

     

       572
       572
       -
       

     

       573
       573
       -
         (** {1:submission EmailSubmission objects} *)

     

       574
       574
       -
       

     

       575
       575
       -
         (** EmailSubmission address. See RFC8621 Section 5.1. *)

     

       576
       576
       -
         type submission_address = {

     

       577
       577
       -
           email : string;

     

       578
       578
       -
           parameters : (string * string) list option;

     

       579
       579
       -
         }

     

       580
       580
       -
       

     

       581
       581
       -
         (** Email submission object. See RFC8621 Section 5.1. *)

     

       582
       582
       -
         type email_submission = {

     

       583
       583
       -
           id : id;

     

       584
       584
       -
           identity_id : id;

     

       585
       585
       -
           email_id : id;

     

       586
       586
       -
           thread_id : id;

     

       587
       587
       -
           envelope : envelope option;

     

       588
       588
       -
           send_at : utc_date option;

     

       589
       589
       -
           undo_status : [

     

       590
       590
       -
             | `pending

     

       591
       591
       -
             | `final

     

       592
       592
       -
             | `canceled

     

       593
       593
       -
           ] option;

     

       594
       594
       -
           delivery_status : (string * submission_status) list option;

     

       595
       595
       -
           dsn_blob_ids : (string * id) list option;

     

       596
       596
       -
           mdn_blob_ids : (string * id) list option;

     

       597
       597
       -
         }

     

       598
       598
       -
       

     

       599
       599
       -
         (** Envelope for mail submission. See RFC8621 Section 5.1. *)

     

       600
       600
       -
         and envelope = {

     

       601
       601
       -
           mail_from : submission_address;

     

       602
       602
       -
           rcpt_to : submission_address list;

     

       603
       603
       -
         }

     

       604
       604
       -
       

     

       605
       605
       -
         (** Delivery status for submitted email. See RFC8621 Section 5.1. *)

     

       606
       606
       -
         and submission_status = {

     

       607
       607
       -
           smtp_reply : string;

     

       608
       608
       -
           delivered : string option;

     

       609
       609
       -
         }

     

       610
       610
       -
       

     

       611
       611
       -
         (** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)

     

       612
       612
       -
         type email_submission_get_arguments = {

     

       613
       613
       -
           account_id : id;

     

       614
       614
       -
           ids : id list option;

     

       615
       615
       -
           properties : string list option;

     

       616
       616
       -
         }

     

       617
       617
       -
       

     

       618
       618
       -
         (** EmailSubmission/get response. See RFC8621 Section 5.3. *)

     

       619
       619
       -
         type email_submission_get_response = {

     

       620
       620
       -
           account_id : id;

     

       621
       621
       -
           state : string;

     

       622
       622
       -
           list : email_submission list;

     

       623
       623
       -
           not_found : id list;

     

       624
       624
       -
         }

     

       625
       625
       -
       

     

       626
       626
       -
         (** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)

     

       627
       627
       -
         type email_submission_changes_arguments = {

     

       628
       628
       -
           account_id : id;

     

       629
       629
       -
           since_state : string;

     

       630
       630
       -
           max_changes : unsigned_int option;

     

       631
       631
       -
         }

     

       632
       632
       -
       

     

       633
       633
       -
         (** EmailSubmission/changes response. See RFC8621 Section 5.4. *)

     

       634
       634
       -
         type email_submission_changes_response = {

     

       635
       635
       -
           account_id : id;

     

       636
       636
       -
           old_state : string;

     

       637
       637
       -
           new_state : string;

     

       638
       638
       -
           has_more_changes : bool;

     

       639
       639
       -
           created : id list;

     

       640
       640
       -
           updated : id list;

     

       641
       641
       -
           destroyed : id list;

     

       642
       642
       -
         }

     

       643
       643
       -
       

     

       644
       644
       -
         (** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)

     

       645
       645
       -
         type email_submission_filter_condition = {

     

       646
       646
       -
           identity_id : id option;

     

       647
       647
       -
           email_id : id option;

     

       648
       648
       -
           thread_id : id option;

     

       649
       649
       -
           before : utc_date option;

     

       650
       650
       -
           after : utc_date option;

     

       651
       651
       -
           subject : string option;

     

       652
       652
       -
         }

     

       653
       653
       -
       

     

       654
       654
       -
         type email_submission_query_filter = [

     

       655
       655
       -
           | `And of email_submission_query_filter list

     

       656
       656
       -
           | `Or of email_submission_query_filter list

     

       657
       657
       -
           | `Not of email_submission_query_filter

     

       658
       658
       -
           | `Condition of email_submission_filter_condition

     

       659
       659
       -
         ]

     

       660
       660
       -
       

     

       661
       661
       -
         (** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)

     

       662
       662
       -
         type email_submission_query_arguments = {

     

       663
       663
       -
           account_id : id;

     

       664
       664
       -
           filter : email_submission_query_filter option;

     

       665
       665
       -
           sort : comparator list option;

     

       666
       666
       -
           position : unsigned_int option;

     

       667
       667
       -
           anchor : id option;

     

       668
       668
       -
           anchor_offset : int_t option;

     

       669
       669
       -
           limit : unsigned_int option;

     

       670
       670
       -
           calculate_total : bool option;

     

       671
       671
       -
         }

     

       672
       672
       -
       

     

       673
       673
       -
         (** EmailSubmission/query response. See RFC8621 Section 5.5. *)

     

       674
       674
       -
         type email_submission_query_response = {

     

       675
       675
       -
           account_id : id;

     

       676
       676
       -
           query_state : string;

     

       677
       677
       -
           can_calculate_changes : bool;

     

       678
       678
       -
           position : unsigned_int;

     

       679
       679
       -
           ids : id list;

     

       680
       680
       -
           total : unsigned_int option;

     

       681
       681
       -
         }

     

       682
       682
       -
       

     

       683
       683
       -
         (** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)

     

       684
       684
       -
         type email_submission_set_arguments = {

     

       685
       685
       -
           account_id : id;

     

       686
       686
       -
           if_in_state : string option;

     

       687
       687
       -
           create : (id * email_submission_creation) list option;

     

       688
       688
       -
           update : (id * email_submission_update) list option;

     

       689
       689
       -
           destroy : id list option;

     

       690
       690
       -
           on_success_update_email : (id * email_update) list option;

     

       691
       691
       -
         }

     

       692
       692
       -
       

     

       693
       693
       -
         and email_submission_creation = {

     

       694
       694
       -
           email_id : id;

     

       695
       695
       -
           identity_id : id;

     

       696
       696
       -
           envelope : envelope option;

     

       697
       697
       -
           send_at : utc_date option;

     

       698
       698
       -
         }

     

       699
       699
       -
       

     

       700
       700
       -
         and email_submission_update = {

     

       701
       701
       -
           email_id : id option;

     

       702
       702
       -
           identity_id : id option;

     

       703
       703
       -
           envelope : envelope option;

     

       704
       704
       -
           undo_status : [`canceled] option;

     

       705
       705
       -
         }

     

       706
       706
       -
       

     

       707
       707
       -
         (** EmailSubmission/set response. See RFC8621 Section 5.6. *)

     

       708
       708
       -
         type email_submission_set_response = {

     

       709
       709
       -
           account_id : id;

     

       710
       710
       -
           old_state : string option;

     

       711
       711
       -
           new_state : string;

     

       712
       712
       -
           created : (id * email_submission) list option;

     

       713
       713
       -
           updated : id list option;

     

       714
       714
       -
           destroyed : id list option;

     

       715
       715
       -
           not_created : (id * set_error) list option;

     

       716
       716
       -
           not_updated : (id * set_error) list option;

     

       717
       717
       -
           not_destroyed : (id * set_error) list option;

     

       718
       718
       -
         }

     

       719
       719
       -
       

     

       720
       720
       -
         (** {1:identity Identity objects} *)

     

       721
       721
       -
       

     

       722
       722
       -
         (** Identity for sending mail. See RFC8621 Section 6. *)

     

       723
       723
       -
         type identity = {

     

       724
       724
       -
           id : id;

     

       725
       725
       -
           name : string;

     

       726
       726
       -
           email : string;

     

       727
       727
       -
           reply_to : email_address list option;

     

       728
       728
       -
           bcc : email_address list option;

     

       729
       729
       -
           text_signature : string option;

     

       730
       730
       -
           html_signature : string option;

     

       731
       731
       -
           may_delete : bool;

     

       732
       732
       -
         }

     

       733
       733
       -
       

     

       734
       734
       -
         (** Identity/get request arguments. See RFC8621 Section 6.1. *)

     

       735
       735
       -
         type identity_get_arguments = {

     

       736
       736
       -
           account_id : id;

     

       737
       737
       -
           ids : id list option;

     

       738
       738
       -
           properties : string list option;

     

       739
       739
       -
         }

     

       740
       740
       -
       

     

       741
       741
       -
         (** Identity/get response. See RFC8621 Section 6.1. *)

     

       742
       742
       -
         type identity_get_response = {

     

       743
       743
       -
           account_id : id;

     

       744
       744
       -
           state : string;

     

       745
       745
       -
           list : identity list;

     

       746
       746
       -
           not_found : id list;

     

       747
       747
       -
         }

     

       748
       748
       -
       

     

       749
       749
       -
         (** Identity/changes request arguments. See RFC8621 Section 6.2. *)

     

       750
       750
       -
         type identity_changes_arguments = {

     

       751
       751
       -
           account_id : id;

     

       752
       752
       -
           since_state : string;

     

       753
       753
       -
           max_changes : unsigned_int option;

     

       754
       754
       -
         }

     

       755
       755
       -
       

     

       756
       756
       -
         (** Identity/changes response. See RFC8621 Section 6.2. *)

     

       757
       757
       -
         type identity_changes_response = {

     

       758
       758
       -
           account_id : id;

     

       759
       759
       -
           old_state : string;

     

       760
       760
       -
           new_state : string;

     

       761
       761
       -
           has_more_changes : bool;

     

       762
       762
       -
           created : id list;

     

       763
       763
       -
           updated : id list;

     

       764
       764
       -
           destroyed : id list;

     

       765
       765
       -
         }

     

       766
       766
       -
       

     

       767
       767
       -
         (** Identity/set request arguments. See RFC8621 Section 6.3. *)

     

       768
       768
       -
         type identity_set_arguments = {

     

       769
       769
       -
           account_id : id;

     

       770
       770
       -
           if_in_state : string option;

     

       771
       771
       -
           create : (id * identity_creation) list option;

     

       772
       772
       -
           update : (id * identity_update) list option;

     

       773
       773
       -
           destroy : id list option;

     

       774
       774
       -
         }

     

       775
       775
       -
       

     

       776
       776
       -
         and identity_creation = {

     

       777
       777
       -
           name : string;

     

       778
       778
       -
           email : string;

     

       779
       779
       -
           reply_to : email_address list option;

     

       780
       780
       -
           bcc : email_address list option;

     

       781
       781
       -
           text_signature : string option;

     

       782
       782
       -
           html_signature : string option;

     

       783
       783
       -
         }

     

       784
       784
       -
       

     

       785
       785
       -
         and identity_update = {

     

       786
       786
       -
           name : string option;

     

       787
       787
       -
           email : string option;

     

       788
       788
       -
           reply_to : email_address list option;

     

       789
       789
       -
           bcc : email_address list option;

     

       790
       790
       -
           text_signature : string option;

     

       791
       791
       -
           html_signature : string option;

     

       792
       792
       -
         }

     

       793
       793
       -
       

     

       794
       794
       -
         (** Identity/set response. See RFC8621 Section 6.3. *)

     

       795
       795
       -
         type identity_set_response = {

     

       796
       796
       -
           account_id : id;

     

       797
       797
       -
           old_state : string option;

     

       798
       798
       -
           new_state : string;

     

       799
       799
       -
           created : (id * identity) list option;

     

       800
       800
       -
           updated : id list option;

     

       801
       801
       -
           destroyed : id list option;

     

       802
       802
       -
           not_created : (id * set_error) list option;

     

       803
       803
       -
           not_updated : (id * set_error) list option;

     

       804
       804
       -
           not_destroyed : (id * set_error) list option;

     

       805
       805
       -
         }

     

       806
       806
       -
       

     

       807
       807
       -
         (** {1:vacation_response VacationResponse objects} *)

     

       808
       808
       -
       

     

       809
       809
       -
         (** Vacation auto-reply setting. See RFC8621 Section 7. *)

     

       810
       810
       -
         type vacation_response = {

     

       811
       811
       -
           id : id;

     

       812
       812
       -
           is_enabled : bool;

     

       813
       813
       -
           from_date : utc_date option;

     

       814
       814
       -
           to_date : utc_date option;

     

       815
       815
       -
           subject : string option;

     

       816
       816
       -
           text_body : string option;

     

       817
       817
       -
           html_body : string option;

     

       818
       818
       -
         }

     

       819
       819
       -
       

     

       820
       820
       -
         (** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)

     

       821
       821
       -
         type vacation_response_get_arguments = {

     

       822
       822
       -
           account_id : id;

     

       823
       823
       -
           ids : id list option;

     

       824
       824
       -
           properties : string list option;

     

       825
       825
       -
         }

     

       826
       826
       -
       

     

       827
       827
       -
         (** VacationResponse/get response. See RFC8621 Section 7.2. *)

     

       828
       828
       -
         type vacation_response_get_response = {

     

       829
       829
       -
           account_id : id;

     

       830
       830
       -
           state : string;

     

       831
       831
       -
           list : vacation_response list;

     

       832
       832
       -
           not_found : id list;

     

       833
       833
       -
         }

     

       834
       834
       -
       

     

       835
       835
       -
         (** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)

     

       836
       836
       -
         type vacation_response_set_arguments = {

     

       837
       837
       -
           account_id : id;

     

       838
       838
       -
           if_in_state : string option;

     

       839
       839
       -
           update : (id * vacation_response_update) list;

     

       840
       840
       -
         }

     

       841
       841
       -
       

     

       842
       842
       -
         and vacation_response_update = {

     

       843
       843
       -
           is_enabled : bool option;

     

       844
       844
       -
           from_date : utc_date option;

     

       845
       845
       -
           to_date : utc_date option;

     

       846
       846
       -
           subject : string option;

     

       847
       847
       -
           text_body : string option;

     

       848
       848
       -
           html_body : string option;

     

       849
       849
       -
         }

     

       850
       850
       -
       

     

       851
       851
       -
         (** VacationResponse/set response. See RFC8621 Section 7.3. *)

     

       852
       852
       -
         type vacation_response_set_response = {

     

       853
       853
       -
           account_id : id;

     

       854
       854
       -
           old_state : string option;

     

       855
       855
       -
           new_state : string;

     

       856
       856
       -
           updated : id list option;

     

       857
       857
       -
           not_updated : (id * set_error) list option;

     

       858
       858
       -
         }

     

       859
       859
       -
         

     

       860
       860
       -
         (** {1:message_flags Message Flags and Mailbox Attributes} *)

     

       861
       861
       -
         

     

       862
       862
       -
         (** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)

     

       863
       863
       -
         type flag_color =

     

       864
       864
       -
           | Red     (** Bit pattern 000 *)

     

       865
       865
       -
           | Orange  (** Bit pattern 100 *)

     

       866
       866
       -
           | Yellow  (** Bit pattern 010 *)

     

       867
       867
       -
           | Green   (** Bit pattern 111 *)

     

       868
       868
       -
           | Blue    (** Bit pattern 001 *)

     

       869
       869
       -
           | Purple  (** Bit pattern 101 *)

     

       870
       870
       -
           | Gray    (** Bit pattern 011 *)

     

       871
       871
       -
         

     

       872
       872
       -
         (** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)

     

       873
       873
       -
         type message_keyword =

     

       874
       874
       -
           | Notify         (** Indicate a notification should be shown for this message *)

     

       875
       875
       -
           | Muted          (** User is not interested in future replies to this thread *)

     

       876
       876
       -
           | Followed       (** User is particularly interested in future replies to this thread *)

     

       877
       877
       -
           | Memo           (** Message is a note-to-self about another message in the same thread *)

     

       878
       878
       -
           | HasMemo        (** Message has an associated memo with the $memo keyword *)

     

       879
       879
       -
           | HasAttachment  (** Message has an attachment *)

     

       880
       880
       -
           | HasNoAttachment (** Message does not have an attachment *)

     

       881
       881
       -
           | AutoSent       (** Message was sent automatically as a response due to a user rule *)

     

       882
       882
       -
           | Unsubscribed   (** User has unsubscribed from the thread this message is in *)

     

       883
       883
       -
           | CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)

     

       884
       884
       -
           | Imported       (** Message was imported from another mailbox *)

     

       885
       885
       -
           | IsTrusted      (** Server has verified authenticity of the from name and email *)

     

       886
       886
       -
           | MaskedEmail    (** Message was received via an alias created for an individual sender *)

     

       887
       887
       -
           | New            (** Message should be made more prominent due to a recent action *)

     

       888
       888
       -
           | MailFlagBit0   (** Bit 0 of the 3-bit flag color pattern *)

     

       889
       889
       -
           | MailFlagBit1   (** Bit 1 of the 3-bit flag color pattern *)

     

       890
       890
       -
           | MailFlagBit2   (** Bit 2 of the 3-bit flag color pattern *)

     

       891
       891
       -
           | OtherKeyword of string (** Other non-standard keywords *)

     

       892
       892
       -
         

     

       893
       893
       -
         (** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)

     

       894
       894
       -
         type mailbox_attribute =

     

       895
       895
       -
           | Snoozed    (** Mailbox containing messages that have been snoozed *)

     

       896
       896
       -
           | Scheduled  (** Mailbox containing messages scheduled to be sent later *)

     

       897
       897
       -
           | Memos      (** Mailbox containing messages with the $memo keyword *)

     

       898
       898
       -
           | OtherAttribute of string (** Other non-standard mailbox attributes *)

     

       899
       899
       -
         

     

       900
       900
       -
         (** Functions for working with flag colors based on the specification in 

     

       901
       901
       -
             draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)

     

       902
       902
       -
           

     

       903
       903
       -
         (** Convert bit pattern to flag color *)

     

       904
       904
       -
         let flag_color_of_bits bit0 bit1 bit2 =

     

       905
       905
       -
           match (bit0, bit1, bit2) with

     

       906
       906
       -
           | (false, false, false) -> Red     (* 000 *)

     

       907
       907
       -
           | (true, false, false) -> Orange   (* 100 *)

     

       908
       908
       -
           | (false, true, false) -> Yellow   (* 010 *)

     

       909
       909
       -
           | (true, true, true) -> Green      (* 111 *)

     

       910
       910
       -
           | (false, false, true) -> Blue     (* 001 *)

     

       911
       911
       -
           | (true, false, true) -> Purple    (* 101 *)

     

       912
       912
       -
           | (false, true, true) -> Gray      (* 011 *)

     

       913
       913
       -
           | (true, true, false) -> Green     (* 110 - not in spec, defaulting to green *)

     

       914
       914
       -
       

     

       915
       915
       -
         (** Get bits for a flag color *)

     

       916
       916
       -
         let bits_of_flag_color = function

     

       917
       917
       -
           | Red -> (false, false, false)

     

       918
       918
       -
           | Orange -> (true, false, false)

     

       919
       919
       -
           | Yellow -> (false, true, false)

     

       920
       920
       -
           | Green -> (true, true, true)

     

       921
       921
       -
           | Blue -> (false, false, true)

     

       922
       922
       -
           | Purple -> (true, false, true)

     

       923
       923
       -
           | Gray -> (false, true, true)

     

       924
       924
       -
       

     

       925
       925
       -
         (** Check if a keyword list contains a flag color *)

     

       926
       926
       -
         let has_flag_color keywords =

     

       927
       927
       -
           let has_bit0 = List.exists (function 

     

       928
       928
       -
             | (Custom s, true) when s = "$MailFlagBit0" -> true 

     

       929
       929
       -
             | _ -> false

     

       930
       930
       -
           ) keywords in

     

       931
       931
       -
           

     

       932
       932
       -
           let has_bit1 = List.exists (function

     

       933
       933
       -
             | (Custom s, true) when s = "$MailFlagBit1" -> true 

     

       934
       934
       -
             | _ -> false

     

       935
       935
       -
           ) keywords in

     

       936
       936
       -
           

     

       937
       937
       -
           let has_bit2 = List.exists (function

     

       938
       938
       -
             | (Custom s, true) when s = "$MailFlagBit2" -> true 

     

       939
       939
       -
             | _ -> false

     

       940
       940
       -
           ) keywords in

     

       941
       941
       -
           

     

       942
       942
       -
           has_bit0 || has_bit1 || has_bit2

     

       943
       943
       -
       

     

       944
       944
       -
         (** Extract flag color from keywords if present *)

     

       945
       945
       -
         let get_flag_color keywords =

     

       946
       946
       -
           (* First check if the message has the \Flagged system flag *)

     

       947
       947
       -
           let is_flagged = List.exists (function

     

       948
       948
       -
             | (Flagged, true) -> true 

     

       949
       949
       -
             | _ -> false

     

       950
       950
       -
           ) keywords in

     

       951
       951
       -
           

     

       952
       952
       -
           if not is_flagged then

     

       953
       953
       -
             None

     

       954
       954
       -
           else

     

       955
       955
       -
             (* Get values of each bit flag *)

     

       956
       956
       -
             let bit0 = List.exists (function

     

       957
       957
       -
               | (Custom s, true) when s = "$MailFlagBit0" -> true 

     

       958
       958
       -
               | _ -> false

     

       959
       959
       -
             ) keywords in

     

       960
       960
       -
             

     

       961
       961
       -
             let bit1 = List.exists (function

     

       962
       962
       -
               | (Custom s, true) when s = "$MailFlagBit1" -> true 

     

       963
       963
       -
               | _ -> false

     

       964
       964
       -
             ) keywords in

     

       965
       965
       -
             

     

       966
       966
       -
             let bit2 = List.exists (function

     

       967
       967
       -
               | (Custom s, true) when s = "$MailFlagBit2" -> true 

     

       968
       968
       -
               | _ -> false

     

       969
       969
       -
             ) keywords in

     

       970
       970
       -
             

     

       971
       971
       -
             Some (flag_color_of_bits bit0 bit1 bit2)

     

       972
       972
       -
       

     

       973
       973
       -
         (** Convert a message keyword to its string representation *)

     

       974
       974
       -
         let string_of_message_keyword = function

     

       975
       975
       -
           | Notify -> "$notify"

     

       976
       976
       -
           | Muted -> "$muted"

     

       977
       977
       -
           | Followed -> "$followed"

     

       978
       978
       -
           | Memo -> "$memo"

     

       979
       979
       -
           | HasMemo -> "$hasmemo"

     

       980
       980
       -
           | HasAttachment -> "$hasattachment"

     

       981
       981
       -
           | HasNoAttachment -> "$hasnoattachment"

     

       982
       982
       -
           | AutoSent -> "$autosent"

     

       983
       983
       -
           | Unsubscribed -> "$unsubscribed"

     

       984
       984
       -
           | CanUnsubscribe -> "$canunsubscribe"

     

       985
       985
       -
           | Imported -> "$imported"

     

       986
       986
       -
           | IsTrusted -> "$istrusted"

     

       987
       987
       -
           | MaskedEmail -> "$maskedemail"

     

       988
       988
       -
           | New -> "$new"

     

       989
       989
       -
           | MailFlagBit0 -> "$MailFlagBit0"

     

       990
       990
       -
           | MailFlagBit1 -> "$MailFlagBit1"

     

       991
       991
       -
           | MailFlagBit2 -> "$MailFlagBit2"

     

       992
       992
       -
           | OtherKeyword s -> s

     

       993
       993
       -
       

     

       994
       994
       -
         (** Parse a string into a message keyword *)

     

       995
       995
       -
         let message_keyword_of_string = function

     

       996
       996
       -
           | "$notify" -> Notify

     

       997
       997
       -
           | "$muted" -> Muted

     

       998
       998
       -
           | "$followed" -> Followed

     

       999
       999
       -
           | "$memo" -> Memo

     

       1000
       1000
       -
           | "$hasmemo" -> HasMemo

     

       1001
       1001
       -
           | "$hasattachment" -> HasAttachment

     

       1002
       1002
       -
           | "$hasnoattachment" -> HasNoAttachment

     

       1003
       1003
       -
           | "$autosent" -> AutoSent

     

       1004
       1004
       -
           | "$unsubscribed" -> Unsubscribed

     

       1005
       1005
       -
           | "$canunsubscribe" -> CanUnsubscribe

     

       1006
       1006
       -
           | "$imported" -> Imported

     

       1007
       1007
       -
           | "$istrusted" -> IsTrusted

     

       1008
       1008
       -
           | "$maskedemail" -> MaskedEmail

     

       1009
       1009
       -
           | "$new" -> New

     

       1010
       1010
       -
           | "$MailFlagBit0" -> MailFlagBit0

     

       1011
       1011
       -
           | "$MailFlagBit1" -> MailFlagBit1

     

       1012
       1012
       -
           | "$MailFlagBit2" -> MailFlagBit2

     

       1013
       1013
       -
           | s -> OtherKeyword s

     

       1014
       1014
       -
       

     

       1015
       1015
       -
         (** Convert a mailbox attribute to its string representation *)

     

       1016
       1016
       -
         let string_of_mailbox_attribute = function

     

       1017
       1017
       -
           | Snoozed -> "Snoozed"

     

       1018
       1018
       -
           | Scheduled -> "Scheduled"

     

       1019
       1019
       -
           | Memos -> "Memos"

     

       1020
       1020
       -
           | OtherAttribute s -> s

     

       1021
       1021
       -
       

     

       1022
       1022
       -
         (** Parse a string into a mailbox attribute *)

     

       1023
       1023
       -
         let mailbox_attribute_of_string = function

     

       1024
       1024
       -
           | "Snoozed" -> Snoozed

     

       1025
       1025
       -
           | "Scheduled" -> Scheduled

     

       1026
       1026
       -
           | "Memos" -> Memos

     

       1027
       1027
       -
           | s -> OtherAttribute s

     

       1028
       1028
       -
           

     

       1029
       1029
       -
         (** Get a human-readable representation of a flag color *)

     

       1030
       1030
       -
         let human_readable_flag_color = function

     

       1031
       1031
       -
           | Red -> "Red"

     

       1032
       1032
       -
           | Orange -> "Orange"

     

       1033
       1033
       -
           | Yellow -> "Yellow"

     

       1034
       1034
       -
           | Green -> "Green"

     

       1035
       1035
       -
           | Blue -> "Blue"

     

       1036
       1036
       -
           | Purple -> "Purple"

     

       1037
       1037
       -
           | Gray -> "Gray"

     

       1038
       1038
       -
         

     

       1039
       1039
       -
         (** Get a human-readable representation of a message keyword *)

     

       1040
       1040
       -
         let human_readable_message_keyword = function

     

       1041
       1041
       -
           | Notify -> "Notify"

     

       1042
       1042
       -
           | Muted -> "Muted"

     

       1043
       1043
       -
           | Followed -> "Followed"

     

       1044
       1044
       -
           | Memo -> "Memo"

     

       1045
       1045
       -
           | HasMemo -> "Has Memo"

     

       1046
       1046
       -
           | HasAttachment -> "Has Attachment"

     

       1047
       1047
       -
           | HasNoAttachment -> "No Attachment"

     

       1048
       1048
       -
           | AutoSent -> "Auto Sent"

     

       1049
       1049
       -
           | Unsubscribed -> "Unsubscribed"

     

       1050
       1050
       -
           | CanUnsubscribe -> "Can Unsubscribe"

     

       1051
       1051
       -
           | Imported -> "Imported"

     

       1052
       1052
       -
           | IsTrusted -> "Trusted"

     

       1053
       1053
       -
           | MaskedEmail -> "Masked Email"

     

       1054
       1054
       -
           | New -> "New"

     

       1055
       1055
       -
           | MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> "Flag Bit"

     

       1056
       1056
       -
           | OtherKeyword s -> s

     

       1057
       1057
       -
         

     

       1058
       1058
       -
         (** Format email keywords into a human-readable string representation *)

     

       1059
       1059
       -
         let format_email_keywords keywords =

     

       1060
       1060
       -
           (* Get flag color if present *)

     

       1061
       1061
       -
           let color_str =

     

       1062
       1062
       -
             match get_flag_color keywords with

     

       1063
       1063
       -
             | Some color -> human_readable_flag_color color

     

       1064
       1064
       -
             | None -> ""

     

       1065
       1065
       -
           in

     

       1066
       1066
       -
           

     

       1067
       1067
       -
           (* Get standard JMAP keywords *)

     

       1068
       1068
       -
           let standard_keywords = List.filter_map (fun (kw, active) ->

     

       1069
       1069
       -
             if not active then None

     

       1070
       1070
       -
             else match kw with

     

       1071
       1071
       -
             | Flagged -> Some "Flagged"

     

       1072
       1072
       -
             | Answered -> Some "Answered"

     

       1073
       1073
       -
             | Draft -> Some "Draft"

     

       1074
       1074
       -
             | Forwarded -> Some "Forwarded"

     

       1075
       1075
       -
             | Phishing -> Some "Phishing"

     

       1076
       1076
       -
             | Junk -> Some "Junk"

     

       1077
       1077
       -
             | NotJunk -> Some "Not Junk"

     

       1078
       1078
       -
             | Seen -> Some "Seen"

     

       1079
       1079
       -
             | Unread -> Some "Unread"

     

       1080
       1080
       -
             | _ -> None

     

       1081
       1081
       -
           ) keywords in

     

       1082
       1082
       -
           

     

       1083
       1083
       -
           (* Get message keywords *)

     

       1084
       1084
       -
           let message_keywords = List.filter_map (fun (kw, active) ->

     

       1085
       1085
       -
             if not active then None

     

       1086
       1086
       -
             else match kw with

     

       1087
       1087
       -
             | Custom s ->

     

       1088
       1088
       -
               (* Try to parse as message keyword *)

     

       1089
       1089
       -
               let message_kw = message_keyword_of_string s in

     

       1090
       1090
       -
               (match message_kw with

     

       1091
       1091
       -
               | OtherKeyword _ -> None

     

       1092
       1092
       -
               | MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> None

     

       1093
       1093
       -
               | kw -> Some (human_readable_message_keyword kw))

     

       1094
       1094
       -
             | _ -> None

     

       1095
       1095
       -
           ) keywords in

     

       1096
       1096
       -
           

     

       1097
       1097
       -
           (* Combine all human-readable labels *)

     

       1098
       1098
       -
           let all_parts = 

     

       1099
       1099
       -
             (if color_str <> "" then [color_str] else []) @

     

       1100
       1100
       -
             standard_keywords @ 

     

       1101
       1101
       -
             message_keywords 

     

       1102
       1102
       -
           in

     

       1103
       1103
       -
           

     

       1104
       1104
       -
           String.concat ", " all_parts

     

       1105
       1105
       -
       end

     

       1106
       1106
       -
       

     

       1107
       1107
       -
       (** {1 JSON serialization} *)

     

       1108
       1108
       -
       

     

       1109
       1109
       -
       module Json = struct

     

       1110
       1110
       -
         open Types

     

       1111
       1111
       -
         

     

       1112
       1112
       -
         (** {2 Helper functions for serialization} *)

     

       1113
       1113
       -
       

     

       1114
       1114
       -
         let string_of_mailbox_role = function

     

       1115
       1115
       -
           | All -> "all"

     

       1116
       1116
       -
           | Archive -> "archive"

     

       1117
       1117
       -
           | Drafts -> "drafts"

     

       1118
       1118
       -
           | Flagged -> "flagged"

     

       1119
       1119
       -
           | Important -> "important"

     

       1120
       1120
       -
           | Inbox -> "inbox"

     

       1121
       1121
       -
           | Junk -> "junk"

     

       1122
       1122
       -
           | Sent -> "sent"

     

       1123
       1123
       -
           | Trash -> "trash"

     

       1124
       1124
       -
           | Unknown s -> s

     

       1125
       1125
       -
         

     

       1126
       1126
       -
         let mailbox_role_of_string = function

     

       1127
       1127
       -
           | "all" -> All

     

       1128
       1128
       -
           | "archive" -> Archive

     

       1129
       1129
       -
           | "drafts" -> Drafts

     

       1130
       1130
       -
           | "flagged" -> Flagged

     

       1131
       1131
       -
           | "important" -> Important

     

       1132
       1132
       -
           | "inbox" -> Inbox

     

       1133
       1133
       -
           | "junk" -> Junk

     

       1134
       1134
       -
           | "sent" -> Sent

     

       1135
       1135
       -
           | "trash" -> Trash

     

       1136
       1136
       -
           | s -> Unknown s

     

       1137
       1137
       -
       

     

       1138
       1138
       -
         let string_of_keyword = function

     

       1139
       1139
       -
           | Flagged -> "$flagged"

     

       1140
       1140
       -
           | Answered -> "$answered"

     

       1141
       1141
       -
           | Draft -> "$draft"

     

       1142
       1142
       -
           | Forwarded -> "$forwarded"

     

       1143
       1143
       -
           | Phishing -> "$phishing"

     

       1144
       1144
       -
           | Junk -> "$junk"

     

       1145
       1145
       -
           | NotJunk -> "$notjunk"

     

       1146
       1146
       -
           | Seen -> "$seen"

     

       1147
       1147
       -
           | Unread -> "$unread"

     

       1148
       1148
       -
           | Custom s -> s

     

       1149
       1149
       -
         

     

       1150
       1150
       -
         let keyword_of_string = function

     

       1151
       1151
       -
           | "$flagged" -> Flagged

     

       1152
       1152
       -
           | "$answered" -> Answered

     

       1153
       1153
       -
           | "$draft" -> Draft

     

       1154
       1154
       -
           | "$forwarded" -> Forwarded

     

       1155
       1155
       -
           | "$phishing" -> Phishing

     

       1156
       1156
       -
           | "$junk" -> Junk

     

       1157
       1157
       -
           | "$notjunk" -> NotJunk

     

       1158
       1158
       -
           | "$seen" -> Seen

     

       1159
       1159
       -
           | "$unread" -> Unread

     

       1160
       1160
       -
           | s -> Custom s

     

       1161
       1161
       -
       

     

       1162
       1162
       -
         (** {2 Mailbox serialization} *)

     

       1163
       1163
       -
       

     

       1164
       1164
       -
         (** TODO:claude - Need to implement all JSON serialization functions 

     

       1165
       1165
       -
             for each type we've defined. This would be a substantial amount of

     

       1166
       1166
       -
             code and likely require additional understanding of the ezjsonm API. 

     

       1167
       1167
       -
             

     

       1168
       1168
       -
             For a full implementation, we would need functions to convert between

     

       1169
       1169
       -
             OCaml types and JSON for each of:

     

       1170
       1170
       -
             - mailbox, mailbox_rights, mailbox query/update operations

     

       1171
       1171
       -
             - thread operations

     

       1172
       1172
       -
             - email, email_address, header, email_body_part

     

       1173
       1173
       -
             - email query/update operations

     

       1174
       1174
       -
             - submission operations 

     

       1175
       1175
       -
             - identity operations

     

       1176
       1176
       -
             - vacation response operations

     

       1177
       1177
       -
         *)

     

       1178
       1178
       -
       end

     

       1179
       1179
       -
       

     

       1180
       1180
       -
       (** {1 API functions} *)

     

       1181
       1181
       -
       

     

       1182
       1182
       -
       open Lwt.Syntax

     

       1183
       1183
       -
       open Jmap.Api

     

       1184
       1184
       -
       open Jmap.Types

     

       1185
       1185
       -
       

     

       1186
       1186
       -
       (** Authentication credentials for a JMAP server *)

     

       1187
       1187
       -
       type credentials = {

     

       1188
       1188
       -
         username: string;

     

       1189
       1189
       -
         password: string;

     

       1190
       1190
       -
       }

     

       1191
       1191
       -
       

     

       1192
       1192
       -
       (** Connection to a JMAP mail server *)

     

       1193
       1193
       -
       type connection = {

     

       1194
       1194
       -
         session: Jmap.Types.session;

     

       1195
       1195
       -
         config: Jmap.Api.config;

     

       1196
       1196
       -
       }

     

       1197
       1197
       -
       

     

       1198
       1198
       -
       (** Convert JSON mail object to OCaml type *)

     

       1199
       1199
       -
       let mailbox_of_json json =

     

       1200
       1200
       -
         try

     

       1201
       1201
       -
           let open Ezjsonm in

     

       1202
       1202
       -
           let id = get_string (find json ["id"]) in

     

       1203
       1203
       -
           let name = get_string (find json ["name"]) in

     

       1204
       1204
       -
           (* Handle parentId which can be null *)

     

       1205
       1205
       -
           let parent_id = 

     

       1206
       1206
       -
             match find_opt json ["parentId"] with

     

       1207
       1207
       -
             | Some (`Null) -> None 

     

       1208
       1208
       -
             | Some (`String s) -> Some s

     

       1209
       1209
       -
             | None -> None

     

       1210
       1210
       -
             | _ -> None

     

       1211
       1211
       -
           in

     

       1212
       1212
       -
           (* Handle role which might be null *)

     

       1213
       1213
       -
           let role = 

     

       1214
       1214
       -
             match find_opt json ["role"] with

     

       1215
       1215
       -
             | Some (`Null) -> None

     

       1216
       1216
       -
             | Some (`String s) -> Some (Json.mailbox_role_of_string s)

     

       1217
       1217
       -
             | None -> None

     

       1218
       1218
       -
             | _ -> None

     

       1219
       1219
       -
           in

     

       1220
       1220
       -
           let sort_order = get_int (find json ["sortOrder"]) in

     

       1221
       1221
       -
           let total_emails = get_int (find json ["totalEmails"]) in

     

       1222
       1222
       -
           let unread_emails = get_int (find json ["unreadEmails"]) in

     

       1223
       1223
       -
           let total_threads = get_int (find json ["totalThreads"]) in

     

       1224
       1224
       -
           let unread_threads = get_int (find json ["unreadThreads"]) in

     

       1225
       1225
       -
           let is_subscribed = get_bool (find json ["isSubscribed"]) in

     

       1226
       1226
       -
           let rights_json = find json ["myRights"] in

     

       1227
       1227
       -
           let my_rights = {

     

       1228
       1228
       -
             Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);

     

       1229
       1229
       -
             may_add_items = get_bool (find rights_json ["mayAddItems"]);

     

       1230
       1230
       -
             may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);

     

       1231
       1231
       -
             may_set_seen = get_bool (find rights_json ["maySetSeen"]);

     

       1232
       1232
       -
             may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);

     

       1233
       1233
       -
             may_create_child = get_bool (find rights_json ["mayCreateChild"]);

     

       1234
       1234
       -
             may_rename = get_bool (find rights_json ["mayRename"]);

     

       1235
       1235
       -
             may_delete = get_bool (find rights_json ["mayDelete"]);

     

       1236
       1236
       -
             may_submit = get_bool (find rights_json ["maySubmit"]);

     

       1237
       1237
       -
           } in

     

       1238
       1238
       -
           let result = {

     

       1239
       1239
       -
             Types.id;

     

       1240
       1240
       -
             name;

     

       1241
       1241
       -
             parent_id;

     

       1242
       1242
       -
             role;

     

       1243
       1243
       -
             sort_order;

     

       1244
       1244
       -
             total_emails;

     

       1245
       1245
       -
             unread_emails;

     

       1246
       1246
       -
             total_threads;

     

       1247
       1247
       -
             unread_threads;

     

       1248
       1248
       -
             is_subscribed;

     

       1249
       1249
       -
             my_rights;

     

       1250
       1250
       -
           } in

     

       1251
       1251
       -
           Ok (result)

     

       1252
       1252
       -
         with

     

       1253
       1253
       -
         | Not_found -> 

     

       1254
       1254
       -
             Error (Parse_error "Required field not found in mailbox object")

     

       1255
       1255
       -
         | Invalid_argument msg -> 

     

       1256
       1256
       -
             Error (Parse_error msg)

     

       1257
       1257
       -
         | e -> 

     

       1258
       1258
       -
             Error (Parse_error (Printexc.to_string e))

     

       1259
       1259
       -
       

     

       1260
       1260
       -
       (** Convert JSON email object to OCaml type *)

     

       1261
       1261
       -
       let email_of_json json =

     

       1262
       1262
       -
         try

     

       1263
       1263
       -
           let open Ezjsonm in

     

       1264
       1264
       -
           

     

       1265
       1265
       -
           let id = get_string (find json ["id"]) in

     

       1266
       1266
       -
           let blob_id = get_string (find json ["blobId"]) in

     

       1267
       1267
       -
           let thread_id = get_string (find json ["threadId"]) in

     

       1268
       1268
       -
           

     

       1269
       1269
       -
           (* Process mailboxIds map *)

     

       1270
       1270
       -
           let mailbox_ids_json = find json ["mailboxIds"] in

     

       1271
       1271
       -
           let mailbox_ids = match mailbox_ids_json with

     

       1272
       1272
       -
             | `O items -> List.map (fun (id, v) -> (id, get_bool v)) items

     

       1273
       1273
       -
             | _ -> raise (Invalid_argument "mailboxIds is not an object")

     

       1274
       1274
       -
           in

     

       1275
       1275
       -
           

     

       1276
       1276
       -
           (* Process keywords map *)

     

       1277
       1277
       -
           let keywords_json = find json ["keywords"] in

     

       1278
       1278
       -
           let keywords = match keywords_json with

     

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

     

       1280
       1280
       -
                 (Json.keyword_of_string k, get_bool v)) items

     

       1281
       1281
       -
             | _ -> raise (Invalid_argument "keywords is not an object")

     

       1282
       1282
       -
           in

     

       1283
       1283
       -
           

     

       1284
       1284
       -
           let size = get_int (find json ["size"]) in

     

       1285
       1285
       -
           let received_at = get_string (find json ["receivedAt"]) in

     

       1286
       1286
       -
           

     

       1287
       1287
       -
           (* Handle messageId which might be an array or missing *)

     

       1288
       1288
       -
           let message_id = 

     

       1289
       1289
       -
             match find_opt json ["messageId"] with

     

       1290
       1290
       -
             | Some (`A ids) -> List.map (fun id -> 

     

       1291
       1291
       -
                 match id with 

     

       1292
       1292
       -
                 | `String s -> s

     

       1293
       1293
       -
                 | _ -> raise (Invalid_argument "messageId item is not a string")

     

       1294
       1294
       -
               ) ids

     

       1295
       1295
       -
             | Some (`String s) -> [s] (* Handle single string case *)

     

       1296
       1296
       -
             | None -> [] (* Handle missing case *)

     

       1297
       1297
       -
             | _ -> raise (Invalid_argument "messageId has unexpected type")

     

       1298
       1298
       -
           in

     

       1299
       1299
       -
           

     

       1300
       1300
       -
           (* Parse optional fields *)

     

       1301
       1301
       -
           let parse_email_addresses opt_json =

     

       1302
       1302
       -
             match opt_json with

     

       1303
       1303
       -
             | Some (`A items) -> 

     

       1304
       1304
       -
                 Some (List.map (fun addr_json ->

     

       1305
       1305
       -
                   let name = 

     

       1306
       1306
       -
                     match find_opt addr_json ["name"] with

     

       1307
       1307
       -
                     | Some (`String s) -> Some s

     

       1308
       1308
       -
                     | Some (`Null) -> None

     

       1309
       1309
       -
                     | None -> None

     

       1310
       1310
       -
                     | _ -> None

     

       1311
       1311
       -
                   in

     

       1312
       1312
       -
                   let email = get_string (find addr_json ["email"]) in

     

       1313
       1313
       -
                   let parameters = 

     

       1314
       1314
       -
                     match find_opt addr_json ["parameters"] with

     

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

     

       1316
       1316
       -
                         match v with

     

       1317
       1317
       -
                         | `String s -> (k, s)

     

       1318
       1318
       -
                         | _ -> (k, "")

     

       1319
       1319
       -
                       ) items

     

       1320
       1320
       -
                     | _ -> []

     

       1321
       1321
       -
                   in

     

       1322
       1322
       -
                   { Types.name; email; parameters }

     

       1323
       1323
       -
                 ) items)

     

       1324
       1324
       -
             | _ -> None

     

       1325
       1325
       -
           in

     

       1326
       1326
       -
           

     

       1327
       1327
       -
           (* Handle optional string arrays with null handling *)

     

       1328
       1328
       -
           let parse_string_array_opt field_name =

     

       1329
       1329
       -
             match find_opt json [field_name] with

     

       1330
       1330
       -
             | Some (`A ids) -> 

     

       1331
       1331
       -
                 Some (List.filter_map (function 

     

       1332
       1332
       -
                   | `String s -> Some s 

     

       1333
       1333
       -
                   | _ -> None

     

       1334
       1334
       -
                 ) ids)

     

       1335
       1335
       -
             | Some (`Null) -> None

     

       1336
       1336
       -
             | None -> None

     

       1337
       1337
       -
             | _ -> None

     

       1338
       1338
       -
           in

     

       1339
       1339
       -
           

     

       1340
       1340
       -
           let in_reply_to = parse_string_array_opt "inReplyTo" in

     

       1341
       1341
       -
           let references = parse_string_array_opt "references" in

     

       1342
       1342
       -
           

     

       1343
       1343
       -
           let sender = parse_email_addresses (find_opt json ["sender"]) in

     

       1344
       1344
       -
           let from = parse_email_addresses (find_opt json ["from"]) in

     

       1345
       1345
       -
           let to_ = parse_email_addresses (find_opt json ["to"]) in

     

       1346
       1346
       -
           let cc = parse_email_addresses (find_opt json ["cc"]) in

     

       1347
       1347
       -
           let bcc = parse_email_addresses (find_opt json ["bcc"]) in

     

       1348
       1348
       -
           let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in

     

       1349
       1349
       -
           

     

       1350
       1350
       -
           (* Handle optional string fields with null handling *)

     

       1351
       1351
       -
           let parse_string_opt field_name =

     

       1352
       1352
       -
             match find_opt json [field_name] with

     

       1353
       1353
       -
             | Some (`String s) -> Some s

     

       1354
       1354
       -
             | Some (`Null) -> None

     

       1355
       1355
       -
             | None -> None

     

       1356
       1356
       -
             | _ -> None

     

       1357
       1357
       -
           in

     

       1358
       1358
       -
           

     

       1359
       1359
       -
           let subject = parse_string_opt "subject" in

     

       1360
       1360
       -
           let sent_at = parse_string_opt "sentAt" in

     

       1361
       1361
       -
           

     

       1362
       1362
       -
           (* Handle optional boolean fields with null handling *)

     

       1363
       1363
       -
           let parse_bool_opt field_name =

     

       1364
       1364
       -
             match find_opt json [field_name] with

     

       1365
       1365
       -
             | Some (`Bool b) -> Some b

     

       1366
       1366
       -
             | Some (`Null) -> None

     

       1367
       1367
       -
             | None -> None

     

       1368
       1368
       -
             | _ -> None

     

       1369
       1369
       -
           in

     

       1370
       1370
       -
           

     

       1371
       1371
       -
           let has_attachment = parse_bool_opt "hasAttachment" in

     

       1372
       1372
       -
           let preview = parse_string_opt "preview" in

     

       1373
       1373
       -
           

     

       1374
       1374
       -
           (* TODO Body parts parsing would go here - omitting for brevity *)

     

       1375
       1375
       -
           Ok ({

     

       1376
       1376
       -
             Types.id;

     

       1377
       1377
       -
             blob_id;

     

       1378
       1378
       -
             thread_id;

     

       1379
       1379
       -
             mailbox_ids;

     

       1380
       1380
       -
             keywords;

     

       1381
       1381
       -
             size;

     

       1382
       1382
       -
             received_at;

     

       1383
       1383
       -
             message_id;

     

       1384
       1384
       -
             in_reply_to;

     

       1385
       1385
       -
             references;

     

       1386
       1386
       -
             sender;

     

       1387
       1387
       -
             from;

     

       1388
       1388
       -
             to_;

     

       1389
       1389
       -
             cc;

     

       1390
       1390
       -
             bcc;

     

       1391
       1391
       -
             reply_to;

     

       1392
       1392
       -
             subject;

     

       1393
       1393
       -
             sent_at;

     

       1394
       1394
       -
             has_attachment;

     

       1395
       1395
       -
             preview;

     

       1396
       1396
       -
             body_values = None;

     

       1397
       1397
       -
             text_body = None;

     

       1398
       1398
       -
             html_body = None;

     

       1399
       1399
       -
             attachments = None;

     

       1400
       1400
       -
             headers = None;

     

       1401
       1401
       -
           })

     

       1402
       1402
       -
         with

     

       1403
       1403
       -
         | Not_found -> 

     

       1404
       1404
       -
             Error (Parse_error "Required field not found in email object")

     

       1405
       1405
       -
         | Invalid_argument msg -> 

     

       1406
       1406
       -
             Error (Parse_error msg)

     

       1407
       1407
       -
         | e -> 

     

       1408
       1408
       -
             Error (Parse_error (Printexc.to_string e))

     

       1409
       1409
       -
       

     

       1410
       1410
       -
       (** Login to a JMAP server and establish a connection

     

       1411
       1411
       -
           @param uri The URI of the JMAP server

     

       1412
       1412
       -
           @param credentials Authentication credentials

     

       1413
       1413
       -
           @return A connection object if successful

     

       1414
       1414
       -
           

     

       1415
       1415
       -
           TODO:claude *)

     

       1416
       1416
       -
       let login ~uri ~credentials =

     

       1417
       1417
       -
         let* session_result = get_session (Uri.of_string uri) 

     

       1418
       1418
       -
             ~username:credentials.username 

     

       1419
       1419
       -
             ~authentication_token:credentials.password 

     

       1420
       1420
       -
             () in

     

       1421
       1421
       -
         match session_result with

     

       1422
       1422
       -
         | Ok session ->

     

       1423
       1423
       -
             let api_uri = Uri.of_string session.api_url in

     

       1424
       1424
       -
             let config = {

     

       1425
       1425
       -
               api_uri;

     

       1426
       1426
       -
               username = credentials.username;

     

       1427
       1427
       -
               authentication_token = credentials.password;

     

       1428
       1428
       -
             } in

     

       1429
       1429
       -
             Lwt.return (Ok { session; config })

     

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

     

       1431
       1431
       -
       

     

       1432
       1432
       -
       (** Login to a JMAP server using an API token

     

       1433
       1433
       -
           @param uri The URI of the JMAP server

     

       1434
       1434
       -
           @param api_token The API token for authentication

     

       1435
       1435
       -
           @return A connection object if successful

     

       1436
       1436
       -
           

     

       1437
       1437
       -
           TODO:claude *)

     

       1438
       1438
       -
       let login_with_token ~uri ~api_token =

     

       1439
       1439
       -
         let* session_result = get_session (Uri.of_string uri) 

     

       1440
       1440
       -
             ~api_token 

     

       1441
       1441
       -
             () in

     

       1442
       1442
       -
         match session_result with

     

       1443
       1443
       -
         | Ok session ->

     

       1444
       1444
       -
             let api_uri = Uri.of_string session.api_url in

     

       1445
       1445
       -
             let config = {

     

       1446
       1446
       -
               api_uri;

     

       1447
       1447
       -
               username = ""; (* Empty username indicates we're using token auth *)

     

       1448
       1448
       -
               authentication_token = api_token;

     

       1449
       1449
       -
             } in

     

       1450
       1450
       -
             Lwt.return (Ok { session; config })

     

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

     

       1452
       1452
       -
       

     

       1453
       1453
       -
       (** Get all mailboxes for an account

     

       1454
       1454
       -
           @param conn The JMAP connection

     

       1455
       1455
       -
           @param account_id The account ID to get mailboxes for

     

       1456
       1456
       -
           @return A list of mailboxes if successful

     

       1457
       1457
       -
           

     

       1458
       1458
       -
           TODO:claude *)

     

       1459
       1459
       -
       let get_mailboxes conn ~account_id =

     

       1460
       1460
       -
         let request = {

     

       1461
       1461
       -
           using = [

     

       1462
       1462
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1463
       1463
       -
             Capability.to_string Capability.Mail

     

       1464
       1464
       -
           ];

     

       1465
       1465
       -
           method_calls = [

     

       1466
       1466
       -
             {

     

       1467
       1467
       -
               name = "Mailbox/get";

     

       1468
       1468
       -
               arguments = `O [

     

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

     

       1470
       1470
       -
               ];

     

       1471
       1471
       -
               method_call_id = "m1";

     

       1472
       1472
       -
             }

     

       1473
       1473
       -
           ];

     

       1474
       1474
       -
           created_ids = None;

     

       1475
       1475
       -
         } in

     

       1476
       1476
       -
         

     

       1477
       1477
       -
         let* response_result = make_request conn.config request in

     

       1478
       1478
       -
         match response_result with

     

       1479
       1479
       -
         | Ok response ->

     

       1480
       1480
       -
             let result = 

     

       1481
       1481
       -
               try

     

       1482
       1482
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1483
       1483
       -
                   inv.name = "Mailbox/get") response.method_responses in

     

       1484
       1484
       -
                 let args = method_response.arguments in

     

       1485
       1485
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1486
       1486
       -
                 | Some (`A mailbox_list) ->

     

       1487
       1487
       -
                     let parse_results = List.map mailbox_of_json mailbox_list in

     

       1488
       1488
       -
                     let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1489
       1489
       -
                     if List.length failures > 0 then

     

       1490
       1490
       -
                       Error (Parse_error "Failed to parse some mailboxes")

     

       1491
       1491
       -
                     else

     

       1492
       1492
       -
                       Ok (List.map Result.get_ok successes)

     

       1493
       1493
       -
                 | _ -> Error (Parse_error "Mailbox list not found in response")

     

       1494
       1494
       -
               with

     

       1495
       1495
       -
               | Not_found -> Error (Parse_error "Mailbox/get method response not found")

     

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

     

       1497
       1497
       -
             in

     

       1498
       1498
       -
             Lwt.return result

     

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

     

       1500
       1500
       -
       

     

       1501
       1501
       -
       (** Get a specific mailbox by ID

     

       1502
       1502
       -
           @param conn The JMAP connection

     

       1503
       1503
       -
           @param account_id The account ID

     

       1504
       1504
       -
           @param mailbox_id The mailbox ID to retrieve

     

       1505
       1505
       -
           @return The mailbox if found

     

       1506
       1506
       -
           

     

       1507
       1507
       -
           TODO:claude *)

     

       1508
       1508
       -
       let get_mailbox conn ~account_id ~mailbox_id =

     

       1509
       1509
       -
         let request = {

     

       1510
       1510
       -
           using = [

     

       1511
       1511
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1512
       1512
       -
             Capability.to_string Capability.Mail

     

       1513
       1513
       -
           ];

     

       1514
       1514
       -
           method_calls = [

     

       1515
       1515
       -
             {

     

       1516
       1516
       -
               name = "Mailbox/get";

     

       1517
       1517
       -
               arguments = `O [

     

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

     

       1519
       1519
       -
                 ("ids", `A [`String mailbox_id]);

     

       1520
       1520
       -
               ];

     

       1521
       1521
       -
               method_call_id = "m1";

     

       1522
       1522
       -
             }

     

       1523
       1523
       -
           ];

     

       1524
       1524
       -
           created_ids = None;

     

       1525
       1525
       -
         } in

     

       1526
       1526
       -
         

     

       1527
       1527
       -
         let* response_result = make_request conn.config request in

     

       1528
       1528
       -
         match response_result with

     

       1529
       1529
       -
         | Ok response ->

     

       1530
       1530
       -
             let result = 

     

       1531
       1531
       -
               try

     

       1532
       1532
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1533
       1533
       -
                   inv.name = "Mailbox/get") response.method_responses in

     

       1534
       1534
       -
                 let args = method_response.arguments in

     

       1535
       1535
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1536
       1536
       -
                 | Some (`A [mailbox]) -> mailbox_of_json mailbox

     

       1537
       1537
       -
                 | Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))

     

       1538
       1538
       -
                 | _ -> Error (Parse_error "Expected single mailbox in response")

     

       1539
       1539
       -
               with

     

       1540
       1540
       -
               | Not_found -> Error (Parse_error "Mailbox/get method response not found")

     

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

     

       1542
       1542
       -
             in

     

       1543
       1543
       -
             Lwt.return result

     

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

     

       1545
       1545
       -
       

     

       1546
       1546
       -
       (** Get messages in a mailbox

     

       1547
       1547
       -
           @param conn The JMAP connection

     

       1548
       1548
       -
           @param account_id The account ID

     

       1549
       1549
       -
           @param mailbox_id The mailbox ID to get messages from

     

       1550
       1550
       -
           @param limit Optional limit on number of messages to return

     

       1551
       1551
       -
           @return The list of email messages if successful

     

       1552
       1552
       -
           

     

       1553
       1553
       -
           TODO:claude *)

     

       1554
       1554
       -
       let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =

     

       1555
       1555
       -
         (* First query the emails in the mailbox *)

     

       1556
       1556
       -
         let query_request = {

     

       1557
       1557
       -
           using = [

     

       1558
       1558
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1559
       1559
       -
             Capability.to_string Capability.Mail

     

       1560
       1560
       -
           ];

     

       1561
       1561
       -
           method_calls = [

     

       1562
       1562
       -
             {

     

       1563
       1563
       -
               name = "Email/query";

     

       1564
       1564
       -
               arguments = `O ([

     

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

     

       1566
       1566
       -
                 ("filter", `O [("inMailbox", `String mailbox_id)]);

     

       1567
       1567
       -
                 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);

     

       1568
       1568
       -
               ] @ (match limit with

     

       1569
       1569
       -
                 | Some l -> [("limit", `Float (float_of_int l))]

     

       1570
       1570
       -
                 | None -> []

     

       1571
       1571
       -
               ));

     

       1572
       1572
       -
               method_call_id = "q1";

     

       1573
       1573
       -
             }

     

       1574
       1574
       -
           ];

     

       1575
       1575
       -
           created_ids = None;

     

       1576
       1576
       -
         } in

     

       1577
       1577
       -
         

     

       1578
       1578
       -
         let* query_result = make_request conn.config query_request in

     

       1579
       1579
       -
         match query_result with

     

       1580
       1580
       -
         | Ok query_response ->

     

       1581
       1581
       -
             (try

     

       1582
       1582
       -
                let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1583
       1583
       -
                  inv.name = "Email/query") query_response.method_responses in

     

       1584
       1584
       -
                let args = query_method.arguments in

     

       1585
       1585
       -
                match Ezjsonm.find_opt args ["ids"] with

     

       1586
       1586
       -
                | Some (`A ids) ->

     

       1587
       1587
       -
                    let email_ids = List.map (function 

     

       1588
       1588
       -
                      | `String id -> id 

     

       1589
       1589
       -
                      | _ -> raise (Invalid_argument "Email ID is not a string")

     

       1590
       1590
       -
                    ) ids in

     

       1591
       1591
       -
                    

     

       1592
       1592
       -
                    (* If we have IDs, fetch the actual email objects *)

     

       1593
       1593
       -
                    if List.length email_ids > 0 then

     

       1594
       1594
       -
                      let get_request = {

     

       1595
       1595
       -
                        using = [

     

       1596
       1596
       -
                          Jmap.Capability.to_string Jmap.Capability.Core;

     

       1597
       1597
       -
                          Capability.to_string Capability.Mail

     

       1598
       1598
       -
                        ];

     

       1599
       1599
       -
                        method_calls = [

     

       1600
       1600
       -
                          {

     

       1601
       1601
       -
                            name = "Email/get";

     

       1602
       1602
       -
                            arguments = `O [

     

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

     

       1604
       1604
       -
                              ("ids", `A (List.map (fun id -> `String id) email_ids));

     

       1605
       1605
       -
                            ];

     

       1606
       1606
       -
                            method_call_id = "g1";

     

       1607
       1607
       -
                          }

     

       1608
       1608
       -
                        ];

     

       1609
       1609
       -
                        created_ids = None;

     

       1610
       1610
       -
                      } in

     

       1611
       1611
       -
                      

     

       1612
       1612
       -
                      let* get_result = make_request conn.config get_request in

     

       1613
       1613
       -
                      match get_result with

     

       1614
       1614
       -
                      | Ok get_response -> 

     

       1615
       1615
       -
                          (try

     

       1616
       1616
       -
                             let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1617
       1617
       -
                               inv.name = "Email/get") get_response.method_responses in

     

       1618
       1618
       -
                             let args = get_method.arguments in

     

       1619
       1619
       -
                             match Ezjsonm.find_opt args ["list"] with

     

       1620
       1620
       -
                             | Some (`A email_list) ->

     

       1621
       1621
       -
                                 let parse_results = List.map email_of_json email_list in

     

       1622
       1622
       -
                                 let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1623
       1623
       -
                                 if List.length failures > 0 then

     

       1624
       1624
       -
                                   Lwt.return (Error (Parse_error "Failed to parse some emails"))

     

       1625
       1625
       -
                                 else

     

       1626
       1626
       -
                                   Lwt.return (Ok (List.map Result.get_ok successes))

     

       1627
       1627
       -
                             | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))

     

       1628
       1628
       -
                           with

     

       1629
       1629
       -
                           | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))

     

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

     

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

     

       1632
       1632
       -
                    else

     

       1633
       1633
       -
                      (* No emails in mailbox *)

     

       1634
       1634
       -
                      Lwt.return (Ok [])

     

       1635
       1635
       -
                    

     

       1636
       1636
       -
                | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))

     

       1637
       1637
       -
              with

     

       1638
       1638
       -
              | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))

     

       1639
       1639
       -
              | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))

     

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

     

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

     

       1642
       1642
       -
       

     

       1643
       1643
       -
       (** Get a single email message by ID

     

       1644
       1644
       -
           @param conn The JMAP connection

     

       1645
       1645
       -
           @param account_id The account ID

     

       1646
       1646
       -
           @param email_id The email ID to retrieve

     

       1647
       1647
       -
           @return The email message if found

     

       1648
       1648
       -
           

     

       1649
       1649
       -
           TODO:claude *)

     

       1650
       1650
       -
       let get_email conn ~account_id ~email_id =

     

       1651
       1651
       -
         let request = {

     

       1652
       1652
       -
           using = [

     

       1653
       1653
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1654
       1654
       -
             Capability.to_string Capability.Mail

     

       1655
       1655
       -
           ];

     

       1656
       1656
       -
           method_calls = [

     

       1657
       1657
       -
             {

     

       1658
       1658
       -
               name = "Email/get";

     

       1659
       1659
       -
               arguments = `O [

     

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

     

       1661
       1661
       -
                 ("ids", `A [`String email_id]);

     

       1662
       1662
       -
               ];

     

       1663
       1663
       -
               method_call_id = "m1";

     

       1664
       1664
       -
             }

     

       1665
       1665
       -
           ];

     

       1666
       1666
       -
           created_ids = None;

     

       1667
       1667
       -
         } in

     

       1668
       1668
       -
         

     

       1669
       1669
       -
         let* response_result = make_request conn.config request in

     

       1670
       1670
       -
         match response_result with

     

       1671
       1671
       -
         | Ok response ->

     

       1672
       1672
       -
             let result = 

     

       1673
       1673
       -
               try

     

       1674
       1674
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1675
       1675
       -
                   inv.name = "Email/get") response.method_responses in

     

       1676
       1676
       -
                 let args = method_response.arguments in

     

       1677
       1677
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       1678
       1678
       -
                 | Some (`A [email]) -> email_of_json email

     

       1679
       1679
       -
                 | Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))

     

       1680
       1680
       -
                 | _ -> Error (Parse_error "Expected single email in response")

     

       1681
       1681
       -
               with

     

       1682
       1682
       -
               | Not_found -> Error (Parse_error "Email/get method response not found")

     

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

     

       1684
       1684
       -
             in

     

       1685
       1685
       -
             Lwt.return result

     

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

     

       1687
       1687
       -
         

     

       1688
       1688
       -
       (** Helper functions for working with message flags and mailbox attributes *)

     

       1689
       1689
       -
       

     

       1690
       1690
       -
       (** Check if an email has a specific message keyword

     

       1691
       1691
       -
           @param email The email to check

     

       1692
       1692
       -
           @param keyword The message keyword to look for

     

       1693
       1693
       -
           @return true if the email has the keyword, false otherwise

     

       1694
       1694
       -
           

     

       1695
       1695
       -
           TODO:claude *)

     

       1696
       1696
       -
       let has_message_keyword (email:Types.email) keyword =

     

       1697
       1697
       -
         let open Types in

     

       1698
       1698
       -
         let keyword_string = string_of_message_keyword keyword in

     

       1699
       1699
       -
         List.exists (function

     

       1700
       1700
       -
           | (Custom s, true) when s = keyword_string -> true

     

       1701
       1701
       -
           | _ -> false

     

       1702
       1702
       -
         ) email.keywords

     

       1703
       1703
       -
       

     

       1704
       1704
       -
       (** Add a message keyword to an email

     

       1705
       1705
       -
           @param conn The JMAP connection

     

       1706
       1706
       -
           @param account_id The account ID

     

       1707
       1707
       -
           @param email_id The email ID

     

       1708
       1708
       -
           @param keyword The message keyword to add

     

       1709
       1709
       -
           @return Success or error

     

       1710
       1710
       -
           

     

       1711
       1711
       -
           TODO:claude *)

     

       1712
       1712
       -
       let add_message_keyword conn ~account_id ~email_id ~keyword =

     

       1713
       1713
       -
         let keyword_string = Types.string_of_message_keyword keyword in

     

       1714
       1714
       -
         

     

       1715
       1715
       -
         let request = {

     

       1716
       1716
       -
           using = [

     

       1717
       1717
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1718
       1718
       -
             Capability.to_string Capability.Mail

     

       1719
       1719
       -
           ];

     

       1720
       1720
       -
           method_calls = [

     

       1721
       1721
       -
             {

     

       1722
       1722
       -
               name = "Email/set";

     

       1723
       1723
       -
               arguments = `O [

     

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

     

       1725
       1725
       -
                 ("update", `O [

     

       1726
       1726
       -
                   (email_id, `O [

     

       1727
       1727
       -
                     ("keywords", `O [

     

       1728
       1728
       -
                       (keyword_string, `Bool true)

     

       1729
       1729
       -
                     ])

     

       1730
       1730
       -
                   ])

     

       1731
       1731
       -
                 ]);

     

       1732
       1732
       -
               ];

     

       1733
       1733
       -
               method_call_id = "m1";

     

       1734
       1734
       -
             }

     

       1735
       1735
       -
           ];

     

       1736
       1736
       -
           created_ids = None;

     

       1737
       1737
       -
         } in

     

       1738
       1738
       -
         

     

       1739
       1739
       -
         let* response_result = make_request conn.config request in

     

       1740
       1740
       -
         match response_result with

     

       1741
       1741
       -
         | Ok response ->

     

       1742
       1742
       -
             let result = 

     

       1743
       1743
       -
               try

     

       1744
       1744
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1745
       1745
       -
                   inv.name = "Email/set") response.method_responses in

     

       1746
       1746
       -
                 let args = method_response.arguments in

     

       1747
       1747
       -
                 match Ezjsonm.find_opt args ["updated"] with

     

       1748
       1748
       -
                 | Some (`A _ids) -> Ok ()

     

       1749
       1749
       -
                 | _ -> 

     

       1750
       1750
       -
                     match Ezjsonm.find_opt args ["notUpdated"] with

     

       1751
       1751
       -
                     | Some (`O _errors) -> 

     

       1752
       1752
       -
                         Error (Parse_error ("Failed to update email: " ^ email_id))

     

       1753
       1753
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       1754
       1754
       -
               with

     

       1755
       1755
       -
               | Not_found -> Error (Parse_error "Email/set method response not found")

     

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

     

       1757
       1757
       -
             in

     

       1758
       1758
       -
             Lwt.return result

     

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

     

       1760
       1760
       -
       

     

       1761
       1761
       -
       (** Set a flag color for an email

     

       1762
       1762
       -
           @param conn The JMAP connection

     

       1763
       1763
       -
           @param account_id The account ID

     

       1764
       1764
       -
           @param email_id The email ID

     

       1765
       1765
       -
           @param color The flag color to set

     

       1766
       1766
       -
           @return Success or error

     

       1767
       1767
       -
           

     

       1768
       1768
       -
           TODO:claude *)

     

       1769
       1769
       -
       let set_flag_color conn ~account_id ~email_id ~color =

     

       1770
       1770
       -
         (* Get the bit pattern for the color *)

     

       1771
       1771
       -
         let (bit0, bit1, bit2) = Types.bits_of_flag_color color in

     

       1772
       1772
       -
         

     

       1773
       1773
       -
         (* Build the keywords update object *)

     

       1774
       1774
       -
         let keywords = [

     

       1775
       1775
       -
           ("$flagged", `Bool true);

     

       1776
       1776
       -
           ("$MailFlagBit0", `Bool bit0);

     

       1777
       1777
       -
           ("$MailFlagBit1", `Bool bit1);

     

       1778
       1778
       -
           ("$MailFlagBit2", `Bool bit2);

     

       1779
       1779
       -
         ] in

     

       1780
       1780
       -
         

     

       1781
       1781
       -
         let request = {

     

       1782
       1782
       -
           using = [

     

       1783
       1783
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1784
       1784
       -
             Capability.to_string Capability.Mail

     

       1785
       1785
       -
           ];

     

       1786
       1786
       -
           method_calls = [

     

       1787
       1787
       -
             {

     

       1788
       1788
       -
               name = "Email/set";

     

       1789
       1789
       -
               arguments = `O [

     

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

     

       1791
       1791
       -
                 ("update", `O [

     

       1792
       1792
       -
                   (email_id, `O [

     

       1793
       1793
       -
                     ("keywords", `O keywords)

     

       1794
       1794
       -
                   ])

     

       1795
       1795
       -
                 ]);

     

       1796
       1796
       -
               ];

     

       1797
       1797
       -
               method_call_id = "m1";

     

       1798
       1798
       -
             }

     

       1799
       1799
       -
           ];

     

       1800
       1800
       -
           created_ids = None;

     

       1801
       1801
       -
         } in

     

       1802
       1802
       -
         

     

       1803
       1803
       -
         let* response_result = make_request conn.config request in

     

       1804
       1804
       -
         match response_result with

     

       1805
       1805
       -
         | Ok response ->

     

       1806
       1806
       -
             let result = 

     

       1807
       1807
       -
               try

     

       1808
       1808
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1809
       1809
       -
                   inv.name = "Email/set") response.method_responses in

     

       1810
       1810
       -
                 let args = method_response.arguments in

     

       1811
       1811
       -
                 match Ezjsonm.find_opt args ["updated"] with

     

       1812
       1812
       -
                 | Some (`A _ids) -> Ok ()

     

       1813
       1813
       -
                 | _ -> 

     

       1814
       1814
       -
                     match Ezjsonm.find_opt args ["notUpdated"] with

     

       1815
       1815
       -
                     | Some (`O _errors) -> 

     

       1816
       1816
       -
                         Error (Parse_error ("Failed to update email: " ^ email_id))

     

       1817
       1817
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       1818
       1818
       -
               with

     

       1819
       1819
       -
               | Not_found -> Error (Parse_error "Email/set method response not found")

     

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

     

       1821
       1821
       -
             in

     

       1822
       1822
       -
             Lwt.return result

     

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

     

       1824
       1824
       -
       

     

       1825
       1825
       -
       (** Convert an email's keywords to typed message_keyword list

     

       1826
       1826
       -
           @param email The email to analyze

     

       1827
       1827
       -
           @return List of message keywords

     

       1828
       1828
       -
           

     

       1829
       1829
       -
           TODO:claude *)

     

       1830
       1830
       -
       let get_message_keywords (email:Types.email) =

     

       1831
       1831
       -
         let open Types in

     

       1832
       1832
       -
         List.filter_map (function

     

       1833
       1833
       -
           | (Custom s, true) -> Some (message_keyword_of_string s)

     

       1834
       1834
       -
           | _ -> None

     

       1835
       1835
       -
         ) email.keywords

     

       1836
       1836
       -
       

     

       1837
       1837
       -
       (** Get emails with a specific message keyword

     

       1838
       1838
       -
           @param conn The JMAP connection

     

       1839
       1839
       -
           @param account_id The account ID

     

       1840
       1840
       -
           @param keyword The message keyword to search for

     

       1841
       1841
       -
           @param limit Optional limit on number of emails to return

     

       1842
       1842
       -
           @return List of emails with the keyword if successful

     

       1843
       1843
       -
           

     

       1844
       1844
       -
           TODO:claude *)

     

       1845
       1845
       -
       let get_emails_with_keyword conn ~account_id ~keyword ?limit () =

     

       1846
       1846
       -
         let keyword_string = Types.string_of_message_keyword keyword in

     

       1847
       1847
       -
         

     

       1848
       1848
       -
         (* Query for emails with the specified keyword *)

     

       1849
       1849
       -
         let query_request = {

     

       1850
       1850
       -
           using = [

     

       1851
       1851
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       1852
       1852
       -
             Capability.to_string Capability.Mail

     

       1853
       1853
       -
           ];

     

       1854
       1854
       -
           method_calls = [

     

       1855
       1855
       -
             {

     

       1856
       1856
       -
               name = "Email/query";

     

       1857
       1857
       -
               arguments = `O ([

     

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

     

       1859
       1859
       -
                 ("filter", `O [("hasKeyword", `String keyword_string)]);

     

       1860
       1860
       -
                 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);

     

       1861
       1861
       -
               ] @ (match limit with

     

       1862
       1862
       -
                 | Some l -> [("limit", `Float (float_of_int l))]

     

       1863
       1863
       -
                 | None -> []

     

       1864
       1864
       -
               ));

     

       1865
       1865
       -
               method_call_id = "q1";

     

       1866
       1866
       -
             }

     

       1867
       1867
       -
           ];

     

       1868
       1868
       -
           created_ids = None;

     

       1869
       1869
       -
         } in

     

       1870
       1870
       -
         

     

       1871
       1871
       -
         let* query_result = make_request conn.config query_request in

     

       1872
       1872
       -
         match query_result with

     

       1873
       1873
       -
         | Ok query_response ->

     

       1874
       1874
       -
             (try

     

       1875
       1875
       -
                let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1876
       1876
       -
                  inv.name = "Email/query") query_response.method_responses in

     

       1877
       1877
       -
                let args = query_method.arguments in

     

       1878
       1878
       -
                match Ezjsonm.find_opt args ["ids"] with

     

       1879
       1879
       -
                | Some (`A ids) ->

     

       1880
       1880
       -
                    let email_ids = List.map (function 

     

       1881
       1881
       -
                      | `String id -> id 

     

       1882
       1882
       -
                      | _ -> raise (Invalid_argument "Email ID is not a string")

     

       1883
       1883
       -
                    ) ids in

     

       1884
       1884
       -
                    

     

       1885
       1885
       -
                    (* If we have IDs, fetch the actual email objects *)

     

       1886
       1886
       -
                    if List.length email_ids > 0 then

     

       1887
       1887
       -
                      let get_request = {

     

       1888
       1888
       -
                        using = [

     

       1889
       1889
       -
                          Jmap.Capability.to_string Jmap.Capability.Core;

     

       1890
       1890
       -
                          Capability.to_string Capability.Mail

     

       1891
       1891
       -
                        ];

     

       1892
       1892
       -
                        method_calls = [

     

       1893
       1893
       -
                          {

     

       1894
       1894
       -
                            name = "Email/get";

     

       1895
       1895
       -
                            arguments = `O [

     

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

     

       1897
       1897
       -
                              ("ids", `A (List.map (fun id -> `String id) email_ids));

     

       1898
       1898
       -
                            ];

     

       1899
       1899
       -
                            method_call_id = "g1";

     

       1900
       1900
       -
                          }

     

       1901
       1901
       -
                        ];

     

       1902
       1902
       -
                        created_ids = None;

     

       1903
       1903
       -
                      } in

     

       1904
       1904
       -
                      

     

       1905
       1905
       -
                      let* get_result = make_request conn.config get_request in

     

       1906
       1906
       -
                      match get_result with

     

       1907
       1907
       -
                      | Ok get_response -> 

     

       1908
       1908
       -
                          (try

     

       1909
       1909
       -
                             let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       1910
       1910
       -
                               inv.name = "Email/get") get_response.method_responses in

     

       1911
       1911
       -
                             let args = get_method.arguments in

     

       1912
       1912
       -
                             match Ezjsonm.find_opt args ["list"] with

     

       1913
       1913
       -
                             | Some (`A email_list) ->

     

       1914
       1914
       -
                                 let parse_results = List.map email_of_json email_list in

     

       1915
       1915
       -
                                 let (successes, failures) = List.partition Result.is_ok parse_results in

     

       1916
       1916
       -
                                 if List.length failures > 0 then

     

       1917
       1917
       -
                                   Lwt.return (Error (Parse_error "Failed to parse some emails"))

     

       1918
       1918
       -
                                 else

     

       1919
       1919
       -
                                   Lwt.return (Ok (List.map Result.get_ok successes))

     

       1920
       1920
       -
                             | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))

     

       1921
       1921
       -
                           with

     

       1922
       1922
       -
                           | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))

     

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

     

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

     

       1925
       1925
       -
                    else

     

       1926
       1926
       -
                      (* No emails with the keyword *)

     

       1927
       1927
       -
                      Lwt.return (Ok [])

     

       1928
       1928
       -
                    

     

       1929
       1929
       -
                | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))

     

       1930
       1930
       -
              with

     

       1931
       1931
       -
              | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))

     

       1932
       1932
       -
              | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))

     

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

     

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

     

       1935
       1935
       -
       

     

       1936
       1936
       -
       (** {1 Email Submission} *)

     

       1937
       1937
       -
       

     

       1938
       1938
       -
       (** Create a new email draft

     

       1939
       1939
       -
           @param conn The JMAP connection

     

       1940
       1940
       -
           @param account_id The account ID

     

       1941
       1941
       -
           @param mailbox_id The mailbox ID to store the draft in (usually "drafts")

     

       1942
       1942
       -
           @param from The sender's email address 

     

       1943
       1943
       -
           @param to_addresses List of recipient email addresses

     

       1944
       1944
       -
           @param subject The email subject line

     

       1945
       1945
       -
           @param text_body Plain text message body

     

       1946
       1946
       -
           @param html_body Optional HTML message body

     

       1947
       1947
       -
           @return The created email ID if successful

     

       1948
       1948
       -
           

     

       1949
       1949
       -
           TODO:claude

     

       1950
       1950
       -
       *)

     

       1951
       1951
       -
       let create_email_draft conn ~account_id ~mailbox_id ~from ~to_addresses ~subject ~text_body ?html_body () =

     

       1952
       1952
       -
         (* Create email addresses *)

     

       1953
       1953
       -
         let from_addr = {

     

       1954
       1954
       -
           Types.name = None;

     

       1955
       1955
       -
           email = from;

     

       1956
       1956
       -
           parameters = [];

     

       1957
       1957
       -
         } in

     

       1958
       1958
       -
         

     

       1959
       1959
       -
         let to_addrs = List.map (fun addr -> {

     

       1960
       1960
       -
           Types.name = None;

     

       1961
       1961
       -
           email = addr;

     

       1962
       1962
       -
           parameters = [];

     

       1963
       1963
       -
         }) to_addresses in

     

       1964
       1964
       -
         

     

       1965
       1965
       -
         (* Create text body part *)

     

       1966
       1966
       -
         let text_part = {

     

       1967
       1967
       -
           Types.part_id = Some "part1";

     

       1968
       1968
       -
           blob_id = None;

     

       1969
       1969
       -
           size = None;

     

       1970
       1970
       -
           headers = None;

     

       1971
       1971
       -
           name = None;

     

       1972
       1972
       -
           type_ = Some "text/plain";

     

       1973
       1973
       -
           charset = Some "utf-8";

     

       1974
       1974
       -
           disposition = None;

     

       1975
       1975
       -
           cid = None;

     

       1976
       1976
       -
           language = None;

     

       1977
       1977
       -
           location = None;

     

       1978
       1978
       -
           sub_parts = None;

     

       1979
       1979
       -
           header_parameter_name = None;

     

       1980
       1980
       -
           header_parameter_value = None;

     

       1981
       1981
       -
         } in

     

       1982
       1982
       -
         

     

       1983
       1983
       -
         (* Create HTML body part if provided *)

     

       1984
       1984
       -
         let html_part_opt = match html_body with

     

       1985
       1985
       -
           | Some _html -> Some {

     

       1986
       1986
       -
               Types.part_id = Some "part2";

     

       1987
       1987
       -
               blob_id = None;

     

       1988
       1988
       -
               size = None;

     

       1989
       1989
       -
               headers = None;

     

       1990
       1990
       -
               name = None;

     

       1991
       1991
       -
               type_ = Some "text/html";

     

       1992
       1992
       -
               charset = Some "utf-8";

     

       1993
       1993
       -
               disposition = None;

     

       1994
       1994
       -
               cid = None;

     

       1995
       1995
       -
               language = None;

     

       1996
       1996
       -
               location = None;

     

       1997
       1997
       -
               sub_parts = None;

     

       1998
       1998
       -
               header_parameter_name = None;

     

       1999
       1999
       -
               header_parameter_value = None;

     

       2000
       2000
       -
             }

     

       2001
       2001
       -
           | None -> None

     

       2002
       2002
       -
         in

     

       2003
       2003
       -
         

     

       2004
       2004
       -
         (* Create body values *)

     

       2005
       2005
       -
         let body_values = [

     

       2006
       2006
       -
           ("part1", text_body)

     

       2007
       2007
       -
         ] @ (match html_body with

     

       2008
       2008
       -
           | Some html -> [("part2", html)]

     

       2009
       2009
       -
           | None -> []

     

       2010
       2010
       -
         ) in

     

       2011
       2011
       -
         

     

       2012
       2012
       -
         (* Create email *)

     

       2013
       2013
       -
         let html_body_list = match html_part_opt with

     

       2014
       2014
       -
           | Some part -> Some [part]

     

       2015
       2015
       -
           | None -> None

     

       2016
       2016
       -
         in

     

       2017
       2017
       -
         

     

       2018
       2018
       -
         let _email_creation = {

     

       2019
       2019
       -
           Types.mailbox_ids = [(mailbox_id, true)];

     

       2020
       2020
       -
           keywords = Some [(Draft, true)];

     

       2021
       2021
       -
           received_at = None; (* Server will set this *)

     

       2022
       2022
       -
           message_id = None; (* Server will generate this *)

     

       2023
       2023
       -
           in_reply_to = None;

     

       2024
       2024
       -
           references = None;

     

       2025
       2025
       -
           sender = None;

     

       2026
       2026
       -
           from = Some [from_addr];

     

       2027
       2027
       -
           to_ = Some to_addrs;

     

       2028
       2028
       -
           cc = None;

     

       2029
       2029
       -
           bcc = None;

     

       2030
       2030
       -
           reply_to = None;

     

       2031
       2031
       -
           subject = Some subject;

     

       2032
       2032
       -
           body_values = Some body_values;

     

       2033
       2033
       -
           text_body = Some [text_part];

     

       2034
       2034
       -
           html_body = html_body_list;

     

       2035
       2035
       -
           attachments = None;

     

       2036
       2036
       -
           headers = None;

     

       2037
       2037
       -
         } in

     

       2038
       2038
       -
         

     

       2039
       2039
       -
         let request = {

     

       2040
       2040
       -
           using = [

     

       2041
       2041
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       2042
       2042
       -
             Capability.to_string Capability.Mail

     

       2043
       2043
       -
           ];

     

       2044
       2044
       -
           method_calls = [

     

       2045
       2045
       -
             {

     

       2046
       2046
       -
               name = "Email/set";

     

       2047
       2047
       -
               arguments = `O [

     

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

     

       2049
       2049
       -
                 ("create", `O [

     

       2050
       2050
       -
                   ("draft1", `O (

     

       2051
       2051
       -
                     [

     

       2052
       2052
       -
                       ("mailboxIds", `O [(mailbox_id, `Bool true)]);

     

       2053
       2053
       -
                       ("keywords", `O [("$draft", `Bool true)]);

     

       2054
       2054
       -
                       ("from", `A [`O [("name", `Null); ("email", `String from)]]);

     

       2055
       2055
       -
                       ("to", `A (List.map (fun addr -> 

     

       2056
       2056
       -
                         `O [("name", `Null); ("email", `String addr)]

     

       2057
       2057
       -
                       ) to_addresses));

     

       2058
       2058
       -
                       ("subject", `String subject);

     

       2059
       2059
       -
                       ("bodyStructure", `O [

     

       2060
       2060
       -
                         ("type", `String "multipart/alternative");

     

       2061
       2061
       -
                         ("subParts", `A [

     

       2062
       2062
       -
                           `O [

     

       2063
       2063
       -
                             ("partId", `String "part1");

     

       2064
       2064
       -
                             ("type", `String "text/plain")

     

       2065
       2065
       -
                           ];

     

       2066
       2066
       -
                           `O [

     

       2067
       2067
       -
                             ("partId", `String "part2");

     

       2068
       2068
       -
                             ("type", `String "text/html")

     

       2069
       2069
       -
                           ]

     

       2070
       2070
       -
                         ])

     

       2071
       2071
       -
                       ]);

     

       2072
       2072
       -
                       ("bodyValues", `O ([

     

       2073
       2073
       -
                         ("part1", `O [("value", `String text_body)])

     

       2074
       2074
       -
                       ] @ (match html_body with

     

       2075
       2075
       -
                         | Some html -> [("part2", `O [("value", `String html)])]

     

       2076
       2076
       -
                         | None -> [("part2", `O [("value", `String ("<html><body>" ^ text_body ^ "</body></html>"))])]

     

       2077
       2077
       -
                       )))

     

       2078
       2078
       -
                     ]

     

       2079
       2079
       -
                   ))

     

       2080
       2080
       -
                 ])

     

       2081
       2081
       -
               ];

     

       2082
       2082
       -
               method_call_id = "m1";

     

       2083
       2083
       -
             }

     

       2084
       2084
       -
           ];

     

       2085
       2085
       -
           created_ids = None;

     

       2086
       2086
       -
         } in

     

       2087
       2087
       -
         

     

       2088
       2088
       -
         let* response_result = make_request conn.config request in

     

       2089
       2089
       -
         match response_result with

     

       2090
       2090
       -
         | Ok response ->

     

       2091
       2091
       -
             let result = 

     

       2092
       2092
       -
               try

     

       2093
       2093
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2094
       2094
       -
                   inv.name = "Email/set") response.method_responses in

     

       2095
       2095
       -
                 let args = method_response.arguments in

     

       2096
       2096
       -
                 match Ezjsonm.find_opt args ["created"] with

     

       2097
       2097
       -
                 | Some (`O created) ->

     

       2098
       2098
       -
                     let draft_created = List.find_opt (fun (id, _) -> id = "draft1") created in

     

       2099
       2099
       -
                     (match draft_created with

     

       2100
       2100
       -
                     | Some (_, json) -> 

     

       2101
       2101
       -
                         let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in

     

       2102
       2102
       -
                         Ok id

     

       2103
       2103
       -
                     | None -> Error (Parse_error "Created email not found in response"))

     

       2104
       2104
       -
                 | _ -> 

     

       2105
       2105
       -
                     match Ezjsonm.find_opt args ["notCreated"] with

     

       2106
       2106
       -
                     | Some (`O errors) ->

     

       2107
       2107
       -
                         let error_msg = match List.find_opt (fun (id, _) -> id = "draft1") errors with

     

       2108
       2108
       -
                         | Some (_, err) -> 

     

       2109
       2109
       -
                             let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in

     

       2110
       2110
       -
                             let description = 

     

       2111
       2111
       -
                               match Ezjsonm.find_opt err ["description"] with

     

       2112
       2112
       -
                               | Some (`String desc) -> desc

     

       2113
       2113
       -
                               | _ -> "Unknown error"

     

       2114
       2114
       -
                             in

     

       2115
       2115
       -
                             "Error type: " ^ type_ ^ ", Description: " ^ description

     

       2116
       2116
       -
                         | None -> "Unknown error"

     

       2117
       2117
       -
                         in

     

       2118
       2118
       -
                         Error (Parse_error ("Failed to create email: " ^ error_msg))

     

       2119
       2119
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       2120
       2120
       -
               with

     

       2121
       2121
       -
               | Not_found -> Error (Parse_error "Email/set method response not found")

     

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

     

       2123
       2123
       -
             in

     

       2124
       2124
       -
             Lwt.return result

     

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

     

       2126
       2126
       -
       

     

       2127
       2127
       -
       (** Get all identities for an account

     

       2128
       2128
       -
           @param conn The JMAP connection

     

       2129
       2129
       -
           @param account_id The account ID

     

       2130
       2130
       -
           @return A list of identities if successful

     

       2131
       2131
       -
           

     

       2132
       2132
       -
           TODO:claude

     

       2133
       2133
       -
       *)

     

       2134
       2134
       -
       let get_identities conn ~account_id =

     

       2135
       2135
       -
         let request = {

     

       2136
       2136
       -
           using = [

     

       2137
       2137
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       2138
       2138
       -
             Capability.to_string Capability.Submission

     

       2139
       2139
       -
           ];

     

       2140
       2140
       -
           method_calls = [

     

       2141
       2141
       -
             {

     

       2142
       2142
       -
               name = "Identity/get";

     

       2143
       2143
       -
               arguments = `O [

     

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

     

       2145
       2145
       -
               ];

     

       2146
       2146
       -
               method_call_id = "m1";

     

       2147
       2147
       -
             }

     

       2148
       2148
       -
           ];

     

       2149
       2149
       -
           created_ids = None;

     

       2150
       2150
       -
         } in

     

       2151
       2151
       -
         

     

       2152
       2152
       -
         let* response_result = make_request conn.config request in

     

       2153
       2153
       -
         match response_result with

     

       2154
       2154
       -
         | Ok response ->

     

       2155
       2155
       -
             let result = 

     

       2156
       2156
       -
               try

     

       2157
       2157
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2158
       2158
       -
                   inv.name = "Identity/get") response.method_responses in

     

       2159
       2159
       -
                 let args = method_response.arguments in

     

       2160
       2160
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       2161
       2161
       -
                 | Some (`A identities) ->

     

       2162
       2162
       -
                     let parse_identity json =

     

       2163
       2163
       -
                       try

     

       2164
       2164
       -
                         let open Ezjsonm in

     

       2165
       2165
       -
                         let id = get_string (find json ["id"]) in

     

       2166
       2166
       -
                         let name = get_string (find json ["name"]) in

     

       2167
       2167
       -
                         let email = get_string (find json ["email"]) in

     

       2168
       2168
       -
                         

     

       2169
       2169
       -
                         let parse_email_addresses field =

     

       2170
       2170
       -
                           match find_opt json [field] with

     

       2171
       2171
       -
                           | Some (`A items) -> 

     

       2172
       2172
       -
                               Some (List.map (fun addr_json ->

     

       2173
       2173
       -
                                 let name = 

     

       2174
       2174
       -
                                   match find_opt addr_json ["name"] with

     

       2175
       2175
       -
                                   | Some (`String s) -> Some s

     

       2176
       2176
       -
                                   | Some (`Null) -> None

     

       2177
       2177
       -
                                   | None -> None

     

       2178
       2178
       -
                                   | _ -> None

     

       2179
       2179
       -
                                 in

     

       2180
       2180
       -
                                 let email = get_string (find addr_json ["email"]) in

     

       2181
       2181
       -
                                 let parameters = 

     

       2182
       2182
       -
                                   match find_opt addr_json ["parameters"] with

     

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

     

       2184
       2184
       -
                                       match v with

     

       2185
       2185
       -
                                       | `String s -> (k, s)

     

       2186
       2186
       -
                                       | _ -> (k, "")

     

       2187
       2187
       -
                                     ) items

     

       2188
       2188
       -
                                   | _ -> []

     

       2189
       2189
       -
                                 in

     

       2190
       2190
       -
                                 { Types.name; email; parameters }

     

       2191
       2191
       -
                               ) items)

     

       2192
       2192
       -
                           | _ -> None

     

       2193
       2193
       -
                         in

     

       2194
       2194
       -
                         

     

       2195
       2195
       -
                         let reply_to = parse_email_addresses "replyTo" in

     

       2196
       2196
       -
                         let bcc = parse_email_addresses "bcc" in

     

       2197
       2197
       -
                         

     

       2198
       2198
       -
                         let text_signature = 

     

       2199
       2199
       -
                           match find_opt json ["textSignature"] with

     

       2200
       2200
       -
                           | Some (`String s) -> Some s

     

       2201
       2201
       -
                           | _ -> None

     

       2202
       2202
       -
                         in

     

       2203
       2203
       -
                         

     

       2204
       2204
       -
                         let html_signature = 

     

       2205
       2205
       -
                           match find_opt json ["htmlSignature"] with

     

       2206
       2206
       -
                           | Some (`String s) -> Some s

     

       2207
       2207
       -
                           | _ -> None

     

       2208
       2208
       -
                         in

     

       2209
       2209
       -
                         

     

       2210
       2210
       -
                         let may_delete = 

     

       2211
       2211
       -
                           match find_opt json ["mayDelete"] with

     

       2212
       2212
       -
                           | Some (`Bool b) -> b

     

       2213
       2213
       -
                           | _ -> false

     

       2214
       2214
       -
                         in

     

       2215
       2215
       -
                         

     

       2216
       2216
       -
                         (* Create our own identity record for simplicity *)

     

       2217
       2217
       -
                         let r : Types.identity = {

     

       2218
       2218
       -
                           id = id; 

     

       2219
       2219
       -
                           name = name; 

     

       2220
       2220
       -
                           email = email; 

     

       2221
       2221
       -
                           reply_to = reply_to; 

     

       2222
       2222
       -
                           bcc = bcc; 

     

       2223
       2223
       -
                           text_signature = text_signature; 

     

       2224
       2224
       -
                           html_signature = html_signature; 

     

       2225
       2225
       -
                           may_delete = may_delete 

     

       2226
       2226
       -
                         } in Ok r

     

       2227
       2227
       -
                       with

     

       2228
       2228
       -
                       | Not_found -> Error (Parse_error "Required field not found in identity object")

     

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

     

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

     

       2231
       2231
       -
                     in

     

       2232
       2232
       -
                     

     

       2233
       2233
       -
                     let results = List.map parse_identity identities in

     

       2234
       2234
       -
                     let (successes, failures) = List.partition Result.is_ok results in

     

       2235
       2235
       -
                     if List.length failures > 0 then

     

       2236
       2236
       -
                       Error (Parse_error "Failed to parse some identity objects")

     

       2237
       2237
       -
                     else

     

       2238
       2238
       -
                       Ok (List.map Result.get_ok successes)

     

       2239
       2239
       -
                 | _ -> Error (Parse_error "Identity list not found in response")

     

       2240
       2240
       -
               with

     

       2241
       2241
       -
               | Not_found -> Error (Parse_error "Identity/get method response not found")

     

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

     

       2243
       2243
       -
             in

     

       2244
       2244
       -
             Lwt.return result

     

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

     

       2246
       2246
       -
       

     

       2247
       2247
       -
       (** Find a suitable identity by email address

     

       2248
       2248
       -
           @param conn The JMAP connection

     

       2249
       2249
       -
           @param account_id The account ID

     

       2250
       2250
       -
           @param email The email address to match

     

       2251
       2251
       -
           @return The identity if found, otherwise Error

     

       2252
       2252
       -
           

     

       2253
       2253
       -
           TODO:claude

     

       2254
       2254
       -
       *)

     

       2255
       2255
       -
       let find_identity_by_email conn ~account_id ~email =

     

       2256
       2256
       -
         let* identities_result = get_identities conn ~account_id in

     

       2257
       2257
       -
         match identities_result with

     

       2258
       2258
       -
         | Ok identities -> begin

     

       2259
       2259
       -
             let matching_identity = List.find_opt (fun (identity:Types.identity) ->

     

       2260
       2260
       -
               (* Exact match *)

     

       2261
       2261
       -
               if String.lowercase_ascii identity.email = String.lowercase_ascii email then

     

       2262
       2262
       -
                 true

     

       2263
       2263
       -
               else

     

       2264
       2264
       -
                 (* Wildcard match (e.g., *@example.com) *)

     

       2265
       2265
       -
                 let parts = String.split_on_char '@' identity.email in

     

       2266
       2266
       -
                 if List.length parts = 2 && List.hd parts = "*" then

     

       2267
       2267
       -
                   let domain = List.nth parts 1 in

     

       2268
       2268
       -
                   let email_parts = String.split_on_char '@' email in

     

       2269
       2269
       -
                   if List.length email_parts = 2 then

     

       2270
       2270
       -
                     List.nth email_parts 1 = domain

     

       2271
       2271
       -
                   else

     

       2272
       2272
       -
                     false

     

       2273
       2273
       -
                 else

     

       2274
       2274
       -
                   false

     

       2275
       2275
       -
             ) identities in

     

       2276
       2276
       -
             

     

       2277
       2277
       -
             match matching_identity with

     

       2278
       2278
       -
             | Some identity -> Lwt.return (Ok identity)

     

       2279
       2279
       -
             | None -> Lwt.return (Error (Parse_error "No matching identity found"))

     

       2280
       2280
       -
         end

     

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

     

       2282
       2282
       -
       

     

       2283
       2283
       -
       (** Submit an email for delivery

     

       2284
       2284
       -
           @param conn The JMAP connection

     

       2285
       2285
       -
           @param account_id The account ID

     

       2286
       2286
       -
           @param identity_id The identity ID to send from

     

       2287
       2287
       -
           @param email_id The email ID to submit

     

       2288
       2288
       -
           @param envelope Optional custom envelope

     

       2289
       2289
       -
           @return The submission ID if successful

     

       2290
       2290
       -
           

     

       2291
       2291
       -
           TODO:claude

     

       2292
       2292
       -
       *)

     

       2293
       2293
       -
       let submit_email conn ~account_id ~identity_id ~email_id ?envelope () =

     

       2294
       2294
       -
         let request = {

     

       2295
       2295
       -
           using = [

     

       2296
       2296
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       2297
       2297
       -
             Capability.to_string Capability.Mail;

     

       2298
       2298
       -
             Capability.to_string Capability.Submission

     

       2299
       2299
       -
           ];

     

       2300
       2300
       -
           method_calls = [

     

       2301
       2301
       -
             {

     

       2302
       2302
       -
               name = "EmailSubmission/set";

     

       2303
       2303
       -
               arguments = `O [

     

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

     

       2305
       2305
       -
                 ("create", `O [

     

       2306
       2306
       -
                   ("submission1", `O (

     

       2307
       2307
       -
                     [

     

       2308
       2308
       -
                       ("emailId", `String email_id);

     

       2309
       2309
       -
                       ("identityId", `String identity_id);

     

       2310
       2310
       -
                     ] @ (match envelope with

     

       2311
       2311
       -
                       | Some env -> [

     

       2312
       2312
       -
                           ("envelope", `O [

     

       2313
       2313
       -
                             ("mailFrom", `O [

     

       2314
       2314
       -
                               ("email", `String env.Types.mail_from.email);

     

       2315
       2315
       -
                               ("parameters", match env.Types.mail_from.parameters with

     

       2316
       2316
       -
                                 | Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)

     

       2317
       2317
       -
                                 | None -> `O []

     

       2318
       2318
       -
                               )

     

       2319
       2319
       -
                             ]);

     

       2320
       2320
       -
                             ("rcptTo", `A (List.map (fun (rcpt:Types.submission_address) -> 

     

       2321
       2321
       -
                               `O [

     

       2322
       2322
       -
                                 ("email", `String rcpt.Types.email);

     

       2323
       2323
       -
                                 ("parameters", match rcpt.Types.parameters with

     

       2324
       2324
       -
                                   | Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)

     

       2325
       2325
       -
                                   | None -> `O []

     

       2326
       2326
       -
                                 )

     

       2327
       2327
       -
                               ]

     

       2328
       2328
       -
                             ) env.Types.rcpt_to))

     

       2329
       2329
       -
                           ])

     

       2330
       2330
       -
                         ]

     

       2331
       2331
       -
                       | None -> []

     

       2332
       2332
       -
                     )

     

       2333
       2333
       -
                   ))

     

       2334
       2334
       -
                 ]);

     

       2335
       2335
       -
                 ("onSuccessUpdateEmail", `O [

     

       2336
       2336
       -
                   (email_id, `O [

     

       2337
       2337
       -
                     ("keywords", `O [

     

       2338
       2338
       -
                       ("$draft", `Bool false);

     

       2339
       2339
       -
                       ("$sent", `Bool true);

     

       2340
       2340
       -
                     ])

     

       2341
       2341
       -
                   ])

     

       2342
       2342
       -
                 ]);

     

       2343
       2343
       -
               ];

     

       2344
       2344
       -
               method_call_id = "m1";

     

       2345
       2345
       -
             }

     

       2346
       2346
       -
           ];

     

       2347
       2347
       -
           created_ids = None;

     

       2348
       2348
       -
         } in

     

       2349
       2349
       -
         

     

       2350
       2350
       -
         let* response_result = make_request conn.config request in

     

       2351
       2351
       -
         match response_result with

     

       2352
       2352
       -
         | Ok response ->

     

       2353
       2353
       -
             let result = 

     

       2354
       2354
       -
               try

     

       2355
       2355
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2356
       2356
       -
                   inv.name = "EmailSubmission/set") response.method_responses in

     

       2357
       2357
       -
                 let args = method_response.arguments in

     

       2358
       2358
       -
                 match Ezjsonm.find_opt args ["created"] with

     

       2359
       2359
       -
                 | Some (`O created) ->

     

       2360
       2360
       -
                     let submission_created = List.find_opt (fun (id, _) -> id = "submission1") created in

     

       2361
       2361
       -
                     (match submission_created with

     

       2362
       2362
       -
                     | Some (_, json) -> 

     

       2363
       2363
       -
                         let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in

     

       2364
       2364
       -
                         Ok id

     

       2365
       2365
       -
                     | None -> Error (Parse_error "Created submission not found in response"))

     

       2366
       2366
       -
                 | _ -> 

     

       2367
       2367
       -
                     match Ezjsonm.find_opt args ["notCreated"] with

     

       2368
       2368
       -
                     | Some (`O errors) ->

     

       2369
       2369
       -
                         let error_msg = match List.find_opt (fun (id, _) -> id = "submission1") errors with

     

       2370
       2370
       -
                         | Some (_, err) -> 

     

       2371
       2371
       -
                             let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in

     

       2372
       2372
       -
                             let description = 

     

       2373
       2373
       -
                               match Ezjsonm.find_opt err ["description"] with

     

       2374
       2374
       -
                               | Some (`String desc) -> desc

     

       2375
       2375
       -
                               | _ -> "Unknown error"

     

       2376
       2376
       -
                             in

     

       2377
       2377
       -
                             "Error type: " ^ type_ ^ ", Description: " ^ description

     

       2378
       2378
       -
                         | None -> "Unknown error"

     

       2379
       2379
       -
                         in

     

       2380
       2380
       -
                         Error (Parse_error ("Failed to submit email: " ^ error_msg))

     

       2381
       2381
       -
                     | _ -> Error (Parse_error "Unexpected response format")

     

       2382
       2382
       -
               with

     

       2383
       2383
       -
               | Not_found -> Error (Parse_error "EmailSubmission/set method response not found")

     

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

     

       2385
       2385
       -
             in

     

       2386
       2386
       -
             Lwt.return result

     

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

     

       2388
       2388
       -
       

     

       2389
       2389
       -
       (** Create and submit an email in one operation

     

       2390
       2390
       -
           @param conn The JMAP connection

     

       2391
       2391
       -
           @param account_id The account ID

     

       2392
       2392
       -
           @param from The sender's email address 

     

       2393
       2393
       -
           @param to_addresses List of recipient email addresses

     

       2394
       2394
       -
           @param subject The email subject line

     

       2395
       2395
       -
           @param text_body Plain text message body

     

       2396
       2396
       -
           @param html_body Optional HTML message body

     

       2397
       2397
       -
           @return The submission ID if successful

     

       2398
       2398
       -
           

     

       2399
       2399
       -
           TODO:claude

     

       2400
       2400
       -
       *)

     

       2401
       2401
       -
       let create_and_submit_email conn ~account_id ~from ~to_addresses ~subject ~text_body ?html_body:_ () =

     

       2402
       2402
       -
         (* First get accounts to find the draft mailbox and identity in a single request *)

     

       2403
       2403
       -
         let* initial_result = 

     

       2404
       2404
       -
           let request = {

     

       2405
       2405
       -
             using = [

     

       2406
       2406
       -
               Jmap.Capability.to_string Jmap.Capability.Core;

     

       2407
       2407
       -
               Capability.to_string Capability.Mail;

     

       2408
       2408
       -
               Capability.to_string Capability.Submission

     

       2409
       2409
       -
             ];

     

       2410
       2410
       -
             method_calls = [

     

       2411
       2411
       -
               {

     

       2412
       2412
       -
                 name = "Mailbox/get";

     

       2413
       2413
       -
                 arguments = `O [

     

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

     

       2415
       2415
       -
                 ];

     

       2416
       2416
       -
                 method_call_id = "m1";

     

       2417
       2417
       -
               };

     

       2418
       2418
       -
               {

     

       2419
       2419
       -
                 name = "Identity/get";

     

       2420
       2420
       -
                 arguments = `O [

     

       2421
       2421
       -
                   ("accountId", `String account_id)

     

       2422
       2422
       -
                 ];

     

       2423
       2423
       -
                 method_call_id = "m2";

     

       2424
       2424
       -
               }

     

       2425
       2425
       -
             ];

     

       2426
       2426
       -
             created_ids = None;

     

       2427
       2427
       -
           } in

     

       2428
       2428
       -
           make_request conn.config request

     

       2429
       2429
       -
         in

     

       2430
       2430
       -
         

     

       2431
       2431
       -
         match initial_result with

     

       2432
       2432
       -
         | Ok initial_response -> begin

     

       2433
       2433
       -
             (* Find drafts mailbox ID *)

     

       2434
       2434
       -
             let find_drafts_result = 

     

       2435
       2435
       -
               try

     

       2436
       2436
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2437
       2437
       -
                   inv.name = "Mailbox/get") initial_response.method_responses in

     

       2438
       2438
       -
                 let args = method_response.arguments in

     

       2439
       2439
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       2440
       2440
       -
                 | Some (`A mailboxes) -> begin

     

       2441
       2441
       -
                     let draft_mailbox = List.find_opt (fun mailbox ->

     

       2442
       2442
       -
                       match Ezjsonm.find_opt mailbox ["role"] with

     

       2443
       2443
       -
                       | Some (`String role) -> role = "drafts"

     

       2444
       2444
       -
                       | _ -> false

     

       2445
       2445
       -
                     ) mailboxes in

     

       2446
       2446
       -
                     

     

       2447
       2447
       -
                     match draft_mailbox with

     

       2448
       2448
       -
                     | Some mb -> Ok (Ezjsonm.get_string (Ezjsonm.find mb ["id"]))

     

       2449
       2449
       -
                     | None -> Error (Parse_error "No drafts mailbox found")

     

       2450
       2450
       -
                  end

     

       2451
       2451
       -
                 | _ -> Error (Parse_error "Mailbox list not found in response")

     

       2452
       2452
       -
               with

     

       2453
       2453
       -
               | Not_found -> Error (Parse_error "Mailbox/get method response not found")

     

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

     

       2455
       2455
       -
             in

     

       2456
       2456
       -
             

     

       2457
       2457
       -
             (* Find matching identity for from address *)

     

       2458
       2458
       -
             let find_identity_result =

     

       2459
       2459
       -
               try

     

       2460
       2460
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2461
       2461
       -
                   inv.name = "Identity/get") initial_response.method_responses in

     

       2462
       2462
       -
                 let args = method_response.arguments in

     

       2463
       2463
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       2464
       2464
       -
                 | Some (`A identities) -> begin

     

       2465
       2465
       -
                     let matching_identity = List.find_opt (fun identity ->

     

       2466
       2466
       -
                       match Ezjsonm.find_opt identity ["email"] with

     

       2467
       2467
       -
                       | Some (`String email) -> 

     

       2468
       2468
       -
                           let email_lc = String.lowercase_ascii email in

     

       2469
       2469
       -
                           let from_lc = String.lowercase_ascii from in

     

       2470
       2470
       -
                           email_lc = from_lc || (* Exact match *)

     

       2471
       2471
       -
                           (* Wildcard domain match *)

     

       2472
       2472
       -
                           (let parts = String.split_on_char '@' email_lc in

     

       2473
       2473
       -
                            if List.length parts = 2 && List.hd parts = "*" then

     

       2474
       2474
       -
                              let domain = List.nth parts 1 in

     

       2475
       2475
       -
                              let from_parts = String.split_on_char '@' from_lc in

     

       2476
       2476
       -
                              if List.length from_parts = 2 then

     

       2477
       2477
       -
                                List.nth from_parts 1 = domain

     

       2478
       2478
       -
                              else false

     

       2479
       2479
       -
                            else false)

     

       2480
       2480
       -
                       | _ -> false

     

       2481
       2481
       -
                     ) identities in

     

       2482
       2482
       -
                     

     

       2483
       2483
       -
                     match matching_identity with

     

       2484
       2484
       -
                     | Some id -> 

     

       2485
       2485
       -
                         let identity_id = Ezjsonm.get_string (Ezjsonm.find id ["id"]) in

     

       2486
       2486
       -
                         Ok identity_id

     

       2487
       2487
       -
                     | None -> Error (Parse_error ("No matching identity found for " ^ from))

     

       2488
       2488
       -
                  end

     

       2489
       2489
       -
                 | _ -> Error (Parse_error "Identity list not found in response")

     

       2490
       2490
       -
               with

     

       2491
       2491
       -
               | Not_found -> Error (Parse_error "Identity/get method response not found")

     

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

     

       2493
       2493
       -
             in

     

       2494
       2494
       -
             

     

       2495
       2495
       -
             (* If we have both required IDs, create and submit the email in one request *)

     

       2496
       2496
       -
             match (find_drafts_result, find_identity_result) with

     

       2497
       2497
       -
             | (Ok drafts_id, Ok identity_id) -> begin

     

       2498
       2498
       -
                 (* Now create and submit the email in a single request *)

     

       2499
       2499
       -
                 let request = {

     

       2500
       2500
       -
                   using = [

     

       2501
       2501
       -
                     Jmap.Capability.to_string Jmap.Capability.Core;

     

       2502
       2502
       -
                     Capability.to_string Capability.Mail;

     

       2503
       2503
       -
                     Capability.to_string Capability.Submission

     

       2504
       2504
       -
                   ];

     

       2505
       2505
       -
                   method_calls = [

     

       2506
       2506
       -
                     {

     

       2507
       2507
       -
                       name = "Email/set";

     

       2508
       2508
       -
                       arguments = `O [

     

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

     

       2510
       2510
       -
                         ("create", `O [

     

       2511
       2511
       -
                           ("draft", `O (

     

       2512
       2512
       -
                             [

     

       2513
       2513
       -
                               ("mailboxIds", `O [(drafts_id, `Bool true)]);

     

       2514
       2514
       -
                               ("keywords", `O [("$draft", `Bool true)]);

     

       2515
       2515
       -
                               ("from", `A [`O [("email", `String from)]]);

     

       2516
       2516
       -
                               ("to", `A (List.map (fun addr -> 

     

       2517
       2517
       -
                                 `O [("email", `String addr)]

     

       2518
       2518
       -
                               ) to_addresses));

     

       2519
       2519
       -
                               ("subject", `String subject);

     

       2520
       2520
       -
                               ("textBody", `A [`O [

     

       2521
       2521
       -
                                 ("partId", `String "body");

     

       2522
       2522
       -
                                 ("type", `String "text/plain")

     

       2523
       2523
       -
                               ]]);

     

       2524
       2524
       -
                               ("bodyValues", `O [

     

       2525
       2525
       -
                                 ("body", `O [

     

       2526
       2526
       -
                                   ("charset", `String "utf-8");

     

       2527
       2527
       -
                                   ("value", `String text_body)

     

       2528
       2528
       -
                                 ])

     

       2529
       2529
       -
                               ])

     

       2530
       2530
       -
                             ]

     

       2531
       2531
       -
                           ))

     

       2532
       2532
       -
                         ]);

     

       2533
       2533
       -
                       ];

     

       2534
       2534
       -
                       method_call_id = "0";

     

       2535
       2535
       -
                     };

     

       2536
       2536
       -
                     {

     

       2537
       2537
       -
                       name = "EmailSubmission/set";

     

       2538
       2538
       -
                       arguments = `O [

     

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

     

       2540
       2540
       -
                         ("create", `O [

     

       2541
       2541
       -
                           ("sendIt", `O [

     

       2542
       2542
       -
                             ("emailId", `String "#draft");

     

       2543
       2543
       -
                             ("identityId", `String identity_id)

     

       2544
       2544
       -
                           ])

     

       2545
       2545
       -
                         ])

     

       2546
       2546
       -
                       ];

     

       2547
       2547
       -
                       method_call_id = "1";

     

       2548
       2548
       -
                     }

     

       2549
       2549
       -
                   ];

     

       2550
       2550
       -
                   created_ids = None;

     

       2551
       2551
       -
                 } in

     

       2552
       2552
       -
                 

     

       2553
       2553
       -
                 let* submit_result = make_request conn.config request in

     

       2554
       2554
       -
                 match submit_result with

     

       2555
       2555
       -
                 | Ok submit_response -> begin

     

       2556
       2556
       -
                     try

     

       2557
       2557
       -
                       let submission_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2558
       2558
       -
                         inv.name = "EmailSubmission/set") submit_response.method_responses in

     

       2559
       2559
       -
                       let args = submission_method.arguments in

     

       2560
       2560
       -
                       

     

       2561
       2561
       -
                       (* Check if email was created and submission was created *)

     

       2562
       2562
       -
                       match Ezjsonm.find_opt args ["created"] with

     

       2563
       2563
       -
                       | Some (`O created) -> begin

     

       2564
       2564
       -
                           (* Extract the submission ID *)

     

       2565
       2565
       -
                           let submission_created = List.find_opt (fun (id, _) -> id = "sendIt") created in

     

       2566
       2566
       -
                           match submission_created with

     

       2567
       2567
       -
                           | Some (_, json) -> 

     

       2568
       2568
       -
                               let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in

     

       2569
       2569
       -
                               Lwt.return (Ok id)

     

       2570
       2570
       -
                           | None -> begin

     

       2571
       2571
       -
                               (* Check if there was an error in creation *)

     

       2572
       2572
       -
                               match Ezjsonm.find_opt args ["notCreated"] with

     

       2573
       2573
       -
                               | Some (`O errors) ->

     

       2574
       2574
       -
                                   let error_msg = match List.find_opt (fun (id, _) -> id = "sendIt") errors with

     

       2575
       2575
       -
                                   | Some (_, err) -> 

     

       2576
       2576
       -
                                       let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in

     

       2577
       2577
       -
                                       let description = 

     

       2578
       2578
       -
                                         match Ezjsonm.find_opt err ["description"] with

     

       2579
       2579
       -
                                         | Some (`String desc) -> desc

     

       2580
       2580
       -
                                         | _ -> "Unknown error"

     

       2581
       2581
       -
                                       in

     

       2582
       2582
       -
                                       "Error type: " ^ type_ ^ ", Description: " ^ description

     

       2583
       2583
       -
                                   | None -> "Unknown error"

     

       2584
       2584
       -
                                   in

     

       2585
       2585
       -
                                   Lwt.return (Error (Parse_error ("Failed to submit email: " ^ error_msg)))

     

       2586
       2586
       -
                               | Some _ -> Lwt.return (Error (Parse_error "Email submission not found in response"))

     

       2587
       2587
       -
                               | None -> Lwt.return (Error (Parse_error "Email submission not found in response"))

     

       2588
       2588
       -
                           end

     

       2589
       2589
       -
                       end

     

       2590
       2590
       -
                       | Some (`Null) -> Lwt.return (Error (Parse_error "No created submissions in response"))

     

       2591
       2591
       -
                       | Some _ -> Lwt.return (Error (Parse_error "Invalid response format for created submissions"))

     

       2592
       2592
       -
                       | None -> Lwt.return (Error (Parse_error "No created submissions in response"))

     

       2593
       2593
       -
                     with

     

       2594
       2594
       -
                     | Not_found -> Lwt.return (Error (Parse_error "EmailSubmission/set method response not found"))

     

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

     

       2596
       2596
       -
                 end

     

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

     

       2598
       2598
       -
              end    

     

       2599
       2599
       -
             | (Error e, _) -> Lwt.return (Error e)

     

       2600
       2600
       -
             | (_, Error e) -> Lwt.return (Error e)

     

       2601
       2601
       -
         end

     

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

     

       2603
       2603
       -
       

     

       2604
       2604
       -
       (** Get status of an email submission

     

       2605
       2605
       -
           @param conn The JMAP connection

     

       2606
       2606
       -
           @param account_id The account ID

     

       2607
       2607
       -
           @param submission_id The email submission ID

     

       2608
       2608
       -
           @return The submission status if successful

     

       2609
       2609
       -
           

     

       2610
       2610
       -
           TODO:claude

     

       2611
       2611
       -
       *)

     

       2612
       2612
       -
       let get_submission_status conn ~account_id ~submission_id =

     

       2613
       2613
       -
         let request = {

     

       2614
       2614
       -
           using = [

     

       2615
       2615
       -
             Jmap.Capability.to_string Jmap.Capability.Core;

     

       2616
       2616
       -
             Capability.to_string Capability.Submission

     

       2617
       2617
       -
           ];

     

       2618
       2618
       -
           method_calls = [

     

       2619
       2619
       -
             {

     

       2620
       2620
       -
               name = "EmailSubmission/get";

     

       2621
       2621
       -
               arguments = `O [

     

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

     

       2623
       2623
       -
                 ("ids", `A [`String submission_id]);

     

       2624
       2624
       -
               ];

     

       2625
       2625
       -
               method_call_id = "m1";

     

       2626
       2626
       -
             }

     

       2627
       2627
       -
           ];

     

       2628
       2628
       -
           created_ids = None;

     

       2629
       2629
       -
         } in

     

       2630
       2630
       -
         

     

       2631
       2631
       -
         let* response_result = make_request conn.config request in

     

       2632
       2632
       -
         match response_result with

     

       2633
       2633
       -
         | Ok response ->

     

       2634
       2634
       -
             let result = 

     

       2635
       2635
       -
               try

     

       2636
       2636
       -
                 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) -> 

     

       2637
       2637
       -
                   inv.name = "EmailSubmission/get") response.method_responses in

     

       2638
       2638
       -
                 let args = method_response.arguments in

     

       2639
       2639
       -
                 match Ezjsonm.find_opt args ["list"] with

     

       2640
       2640
       -
                 | Some (`A [submission]) ->

     

       2641
       2641
       -
                     let parse_submission json =

     

       2642
       2642
       -
                       try

     

       2643
       2643
       -
                         let open Ezjsonm in

     

       2644
       2644
       -
                         let id = get_string (find json ["id"]) in

     

       2645
       2645
       -
                         let identity_id = get_string (find json ["identityId"]) in

     

       2646
       2646
       -
                         let email_id = get_string (find json ["emailId"]) in

     

       2647
       2647
       -
                         let thread_id = get_string (find json ["threadId"]) in

     

       2648
       2648
       -
                         

     

       2649
       2649
       -
                         let envelope = 

     

       2650
       2650
       -
                           match find_opt json ["envelope"] with

     

       2651
       2651
       -
                           | Some (`O env) -> begin

     

       2652
       2652
       -
                               let parse_address addr_json =

     

       2653
       2653
       -
                                 let email = get_string (find addr_json ["email"]) in

     

       2654
       2654
       -
                                 let parameters = 

     

       2655
       2655
       -
                                   match find_opt addr_json ["parameters"] with

     

       2656
       2656
       -
                                   | Some (`O params) -> 

     

       2657
       2657
       -
                                       Some (List.map (fun (k, v) -> (k, get_string v)) params)

     

       2658
       2658
       -
                                   | _ -> None

     

       2659
       2659
       -
                                 in

     

       2660
       2660
       -
                                 { Types.email; parameters }

     

       2661
       2661
       -
                               in

     

       2662
       2662
       -
                               

     

       2663
       2663
       -
                               let mail_from = parse_address (find (`O env) ["mailFrom"]) in

     

       2664
       2664
       -
                               let rcpt_to = 

     

       2665
       2665
       -
                                 match find (`O env) ["rcptTo"] with

     

       2666
       2666
       -
                                 | `A rcpts -> List.map parse_address rcpts

     

       2667
       2667
       -
                                 | _ -> []

     

       2668
       2668
       -
                               in

     

       2669
       2669
       -
                               

     

       2670
       2670
       -
                               Some { Types.mail_from; rcpt_to }

     

       2671
       2671
       -
                           end

     

       2672
       2672
       -
                           | _ -> None

     

       2673
       2673
       -
                         in

     

       2674
       2674
       -
                         

     

       2675
       2675
       -
                         let send_at = 

     

       2676
       2676
       -
                           match find_opt json ["sendAt"] with

     

       2677
       2677
       -
                           | Some (`String date) -> Some date

     

       2678
       2678
       -
                           | _ -> None

     

       2679
       2679
       -
                         in

     

       2680
       2680
       -
                         

     

       2681
       2681
       -
                         let undo_status = 

     

       2682
       2682
       -
                           match find_opt json ["undoStatus"] with

     

       2683
       2683
       -
                           | Some (`String "pending") -> Some `pending

     

       2684
       2684
       -
                           | Some (`String "final") -> Some `final

     

       2685
       2685
       -
                           | Some (`String "canceled") -> Some `canceled

     

       2686
       2686
       -
                           | _ -> None

     

       2687
       2687
       -
                         in

     

       2688
       2688
       -
                         

     

       2689
       2689
       -
                         let parse_delivery_status deliveries =

     

       2690
       2690
       -
                           match deliveries with

     

       2691
       2691
       -
                           | `O statuses ->

     

       2692
       2692
       -
                               Some (List.map (fun (email, status_json) ->

     

       2693
       2693
       -
                                 let smtp_reply = get_string (find status_json ["smtpReply"]) in

     

       2694
       2694
       -
                                 let delivered = 

     

       2695
       2695
       -
                                   match find_opt status_json ["delivered"] with

     

       2696
       2696
       -
                                   | Some (`String d) -> Some d

     

       2697
       2697
       -
                                   | _ -> None

     

       2698
       2698
       -
                                 in

     

       2699
       2699
       -
                                 (email, { Types.smtp_reply; delivered })

     

       2700
       2700
       -
                               ) statuses)

     

       2701
       2701
       -
                           | _ -> None

     

       2702
       2702
       -
                         in

     

       2703
       2703
       -
                         

     

       2704
       2704
       -
                         let delivery_status = 

     

       2705
       2705
       -
                           match find_opt json ["deliveryStatus"] with

     

       2706
       2706
       -
                           | Some status -> parse_delivery_status status

     

       2707
       2707
       -
                           | _ -> None

     

       2708
       2708
       -
                         in

     

       2709
       2709
       -
                         

     

       2710
       2710
       -
                         let dsn_blob_ids =

     

       2711
       2711
       -
                           match find_opt json ["dsnBlobIds"] with

     

       2712
       2712
       -
                           | Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)

     

       2713
       2713
       -
                           | _ -> None

     

       2714
       2714
       -
                         in

     

       2715
       2715
       -
                         

     

       2716
       2716
       -
                         let mdn_blob_ids =

     

       2717
       2717
       -
                           match find_opt json ["mdnBlobIds"] with

     

       2718
       2718
       -
                           | Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)

     

       2719
       2719
       -
                           | _ -> None

     

       2720
       2720
       -
                         in

     

       2721
       2721
       -
                         

     

       2722
       2722
       -
                         Ok {

     

       2723
       2723
       -
                           Types.id;

     

       2724
       2724
       -
                           identity_id;

     

       2725
       2725
       -
                           email_id;

     

       2726
       2726
       -
                           thread_id;

     

       2727
       2727
       -
                           envelope;

     

       2728
       2728
       -
                           send_at;

     

       2729
       2729
       -
                           undo_status;

     

       2730
       2730
       -
                           delivery_status;

     

       2731
       2731
       -
                           dsn_blob_ids;

     

       2732
       2732
       -
                           mdn_blob_ids;

     

       2733
       2733
       -
                         }

     

       2734
       2734
       -
                       with

     

       2735
       2735
       -
                       | Not_found -> Error (Parse_error "Required field not found in submission object")

     

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

     

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

     

       2738
       2738
       -
                     in

     

       2739
       2739
       -
                     

     

       2740
       2740
       -
                     parse_submission submission

     

       2741
       2741
       -
                 | Some (`A []) -> Error (Parse_error ("Submission not found: " ^ submission_id))

     

       2742
       2742
       -
                 | _ -> Error (Parse_error "Expected single submission in response")

     

       2743
       2743
       -
               with

     

       2744
       2744
       -
               | Not_found -> Error (Parse_error "EmailSubmission/get method response not found")

     

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

     

       2746
       2746
       -
             in

     

       2747
       2747
       -
             Lwt.return result

     

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

     

       2749
       2749
       -
       

     

       2750
       2750
       -
       (** {1 Email Address Utilities} *)

     

       2751
       2751
       -
       

     

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

     

       2753
       2753
       -
       let contains_substring str sub =

     

       2754
       2754
       -
         try 

     

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

     

       2756
       2756
       -
           true

     

       2757
       2757
       -
         with Not_found -> false

     

       2758
       2758
       -
       

     

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

     

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

     

       2761
       2761
       -
           @param str String to match against

     

       2762
       2762
       -
           Based on simple recursive wildcard matching algorithm

     

       2763
       2763
       -
       *)

     

       2764
       2764
       -
       let matches_wildcard pattern str =

     

       2765
       2765
       -
         let pattern_len = String.length pattern in

     

       2766
       2766
       -
         let str_len = String.length str in

     

       2767
       2767
       -
         

     

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

     

       2769
       2769
       -
         let pattern = String.lowercase_ascii pattern in

     

       2770
       2770
       -
         let str = String.lowercase_ascii str in

     

       2771
       2771
       -
         

     

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

     

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

     

       2774
       2774
       -
           contains_substring str pattern

     

       2775
       2775
       -
         else

     

       2776
       2776
       -
           (* Classic recursive matching algorithm *)

     

       2777
       2777
       -
           let rec match_from p_pos s_pos =

     

       2778
       2778
       -
             (* Pattern matched to the end *)

     

       2779
       2779
       -
             if p_pos = pattern_len then

     

       2780
       2780
       -
               s_pos = str_len

     

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

     

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

     

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

     

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

     

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

     

       2786
       2786
       -
             else if s_pos < str_len && 

     

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

     

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

     

       2789
       2789
       -
             else

     

       2790
       2790
       -
               false

     

       2791
       2791
       -
           in

     

       2792
       2792
       -
           

     

       2793
       2793
       -
           match_from 0 0

     

       2794
       2794
       -
       

     

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

     

       2796
       2796
       -
           @param email The email address to check

     

       2797
       2797
       -
           @param pattern The filter pattern to match against

     

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

     

       2799
       2799
       -
       *)

     

       2800
       2800
       -
       let email_address_matches email pattern =

     

       2801
       2801
       -
         matches_wildcard pattern email

     

       2802
       2802
       -
       

     

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

     

       2804
       2804
       -
           @param email The email object to check

     

       2805
       2805
       -
           @param pattern The sender filter pattern

     

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

     

       2807
       2807
       -
       *)

     

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

     

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

     

       2810
       2810
       -
         let addresses_match addrs =

     

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

     

       2812
       2812
       -
             email_address_matches addr.email pattern

     

       2813
       2813
       -
           ) addrs

     

       2814
       2814
       -
         in

     

       2815
       2815
       -
         

     

       2816
       2816
       -
         (* Check From addresses first *)

     

       2817
       2817
       -
         let from_match = 

     

       2818
       2818
       -
           match email.Types.from with

     

       2819
       2819
       -
           | Some addrs -> addresses_match addrs

     

       2820
       2820
       -
           | None -> false

     

       2821
       2821
       -
         in

     

       2822
       2822
       -
         

     

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

     

       2824
       2824
       -
         if from_match then true

     

       2825
       2825
       -
         else

     

       2826
       2826
       -
           match email.Types.sender with

     

       2827
       2827
       -
           | Some addrs -> addresses_match addrs

     

       2828
       2828
       -
           | None -> false

-1655

lib/jmap_mail.mli

···

       1
       1
       -
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 

     

       2
       2
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621> RFC8621

     

       3
       3
       -
           

     

       4
       4
       -
           This module implements the JMAP Mail specification, providing types and

     

       5
       5
       -
           functions for working with emails, mailboxes, threads, and other mail-related

     

       6
       6
       -
           objects in the JMAP protocol.

     

       7
       7
       -
       *)

     

       8
       8
       -
       

     

       9
       9
       -
       (** Module for managing JMAP Mail-specific capability URIs as defined in RFC8621 Section 1.3

     

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

     

       11
       11
       -
       *)

     

       12
       12
       -
       module Capability : sig

     

       13
       13
       -
         (** Mail capability URI as defined in RFC8621 Section 1.3

     

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

     

       15
       15
       -
         *)

     

       16
       16
       -
         val mail_uri : string

     

       17
       17
       -
       

     

       18
       18
       -
         (** Submission capability URI as defined in RFC8621 Section 1.3

     

       19
       19
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       20
       20
       -
         *)

     

       21
       21
       -
         val submission_uri : string

     

       22
       22
       -
       

     

       23
       23
       -
         (** Vacation response capability URI as defined in RFC8621 Section 1.3

     

       24
       24
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       25
       25
       -
         *)

     

       26
       26
       -
         val vacation_response_uri : string

     

       27
       27
       -
       

     

       28
       28
       -
         (** All mail extension capability types as defined in RFC8621 Section 1.3

     

       29
       29
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       30
       30
       -
         *)

     

       31
       31
       -
         type t =

     

       32
       32
       -
           | Mail            (** Mail capability for emails and mailboxes *)

     

       33
       33
       -
           | Submission      (** Submission capability for sending emails *)

     

       34
       34
       -
           | VacationResponse (** Vacation response capability for auto-replies *)

     

       35
       35
       -
           | Extension of string (** Custom extension capabilities *)

     

       36
       36
       -
       

     

       37
       37
       -
         (** Convert capability to URI string

     

       38
       38
       -
             @param capability The capability to convert

     

       39
       39
       -
             @return The full URI string for the capability

     

       40
       40
       -
         *)

     

       41
       41
       -
         val to_string : t -> string

     

       42
       42
       -
       

     

       43
       43
       -
         (** Parse a string to a capability

     

       44
       44
       -
             @param uri The capability URI string to parse

     

       45
       45
       -
             @return The parsed capability type

     

       46
       46
       -
         *)

     

       47
       47
       -
         val of_string : string -> t

     

       48
       48
       -
       

     

       49
       49
       -
         (** Check if a capability is a standard mail capability

     

       50
       50
       -
             @param capability The capability to check

     

       51
       51
       -
             @return True if the capability is a standard JMAP Mail capability

     

       52
       52
       -
         *)

     

       53
       53
       -
         val is_standard : t -> bool

     

       54
       54
       -
       

     

       55
       55
       -
         (** Check if a capability string is a standard mail capability

     

       56
       56
       -
             @param uri The capability URI string to check

     

       57
       57
       -
             @return True if the string represents a standard JMAP Mail capability

     

       58
       58
       -
         *)

     

       59
       59
       -
         val is_standard_string : string -> bool

     

       60
       60
       -
       

     

       61
       61
       -
         (** Create a list of capability strings

     

       62
       62
       -
             @param capabilities List of capability types

     

       63
       63
       -
             @return List of capability URI strings

     

       64
       64
       -
         *)

     

       65
       65
       -
         val strings_of_capabilities : t list -> string list

     

       66
       66
       -
       end

     

       67
       67
       -
       

     

       68
       68
       -
       (** Types for the JMAP Mail extension as defined in RFC8621

     

       69
       69
       -
           @see <https://datatracker.ietf.org/doc/html/rfc8621>

     

       70
       70
       -
       *)

     

       71
       71
       -
       module Types : sig

     

       72
       72
       -
         open Jmap.Types

     

       73
       73
       -
       

     

       74
       74
       -
         (** {1 Mail capabilities}

     

       75
       75
       -
             Capability URIs for JMAP Mail extension as defined in RFC8621 Section 1.3

     

       76
       76
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       77
       77
       -
         *)

     

       78
       78
       -
       

     

       79
       79
       -
         (** Capability URI for JMAP Mail as defined in RFC8621 Section 1.3

     

       80
       80
       -
             Identifies support for the Mail data model

     

       81
       81
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       82
       82
       -
         *)

     

       83
       83
       -
         val capability_mail : string

     

       84
       84
       -
       

     

       85
       85
       -
         (** Capability URI for JMAP Submission as defined in RFC8621 Section 1.3

     

       86
       86
       -
             Identifies support for email submission

     

       87
       87
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       88
       88
       -
         *)

     

       89
       89
       -
         val capability_submission : string

     

       90
       90
       -
         

     

       91
       91
       -
         (** Capability URI for JMAP Vacation Response as defined in RFC8621 Section 1.3

     

       92
       92
       -
             Identifies support for vacation auto-reply functionality

     

       93
       93
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>

     

       94
       94
       -
         *)

     

       95
       95
       -
         val capability_vacation_response : string

     

       96
       96
       -
       

     

       97
       97
       -
         (** {1:mailbox Mailbox objects}

     

       98
       98
       -
             Mailbox types as defined in RFC8621 Section 2

     

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

     

       100
       100
       -
         *)

     

       101
       101
       -
       

     

       102
       102
       -
         (** A role for a mailbox as defined in RFC8621 Section 2.

     

       103
       103
       -
             Standardized roles for special mailboxes like Inbox, Sent, etc.

     

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

     

       105
       105
       -
         *)

     

       106
       106
       -
         type mailbox_role =

     

       107
       107
       -
           | All (** All mail mailbox *)

     

       108
       108
       -
           | Archive (** Archived mail mailbox *)

     

       109
       109
       -
           | Drafts (** Draft messages mailbox *)

     

       110
       110
       -
           | Flagged (** Starred/flagged mail mailbox *)

     

       111
       111
       -
           | Important (** Important mail mailbox *)

     

       112
       112
       -
           | Inbox (** Primary inbox mailbox *)

     

       113
       113
       -
           | Junk (** Spam/Junk mail mailbox *)

     

       114
       114
       -
           | Sent (** Sent mail mailbox *)

     

       115
       115
       -
           | Trash (** Deleted/Trash mail mailbox *)

     

       116
       116
       -
           | Unknown of string (** Server-specific custom roles *)

     

       117
       117
       -
         

     

       118
       118
       -
         (** A mailbox (folder) in a mail account as defined in RFC8621 Section 2.

     

       119
       119
       -
             Represents an email folder or label in the account.

     

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

     

       121
       121
       -
         *)

     

       122
       122
       -
         type mailbox = {

     

       123
       123
       -
           id : id;  (** Server-assigned ID for the mailbox *)

     

       124
       124
       -
           name : string;  (** User-visible name for the mailbox *)

     

       125
       125
       -
           parent_id : id option;  (** ID of the parent mailbox, if any *)

     

       126
       126
       -
           role : mailbox_role option;  (** The role of this mailbox, if it's a special mailbox *)

     

       127
       127
       -
           sort_order : unsigned_int;  (** Position for mailbox in the UI *)

     

       128
       128
       -
           total_emails : unsigned_int;  (** Total number of emails in the mailbox *)

     

       129
       129
       -
           unread_emails : unsigned_int;  (** Number of unread emails in the mailbox *)

     

       130
       130
       -
           total_threads : unsigned_int;  (** Total number of threads in the mailbox *)

     

       131
       131
       -
           unread_threads : unsigned_int;  (** Number of threads with unread emails *)

     

       132
       132
       -
           is_subscribed : bool;  (** Has the user subscribed to this mailbox *)

     

       133
       133
       -
           my_rights : mailbox_rights;  (** Access rights for the user on this mailbox *)

     

       134
       134
       -
         }

     

       135
       135
       -
       

     

       136
       136
       -
         (** Rights for a mailbox as defined in RFC8621 Section 2.

     

       137
       137
       -
             Determines the operations a user can perform on a mailbox.

     

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

     

       139
       139
       -
         *)

     

       140
       140
       -
         and mailbox_rights = {

     

       141
       141
       -
           may_read_items : bool;  (** Can the user read messages in this mailbox *)

     

       142
       142
       -
           may_add_items : bool;  (** Can the user add messages to this mailbox *)

     

       143
       143
       -
           may_remove_items : bool;  (** Can the user remove messages from this mailbox *)

     

       144
       144
       -
           may_set_seen : bool;  (** Can the user mark messages as read/unread *)

     

       145
       145
       -
           may_set_keywords : bool;  (** Can the user set keywords/flags on messages *)

     

       146
       146
       -
           may_create_child : bool;  (** Can the user create child mailboxes *)

     

       147
       147
       -
           may_rename : bool;  (** Can the user rename this mailbox *)

     

       148
       148
       -
           may_delete : bool;  (** Can the user delete this mailbox *)

     

       149
       149
       -
           may_submit : bool;  (** Can the user submit messages in this mailbox for delivery *)

     

       150
       150
       -
         }

     

       151
       151
       -
       

     

       152
       152
       -
         (** Filter condition for mailbox queries as defined in RFC8621 Section 2.3.

     

       153
       153
       -
             Used to filter mailboxes in queries.

     

       154
       154
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       155
       155
       -
         *)

     

       156
       156
       -
         type mailbox_filter_condition = {

     

       157
       157
       -
           parent_id : id option;  (** Only include mailboxes with this parent *)

     

       158
       158
       -
           name : string option;  (** Only include mailboxes with this name (case-insensitive substring match) *)

     

       159
       159
       -
           role : string option;  (** Only include mailboxes with this role *)

     

       160
       160
       -
           has_any_role : bool option;  (** If true, only include mailboxes with a role, if false those without *)

     

       161
       161
       -
           is_subscribed : bool option;  (** If true, only include subscribed mailboxes, if false unsubscribed *)

     

       162
       162
       -
         }

     

       163
       163
       -
       

     

       164
       164
       -
         (** Filter for mailbox queries as defined in RFC8621 Section 2.3.

     

       165
       165
       -
             Complex filter for Mailbox/query method.

     

       166
       166
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       167
       167
       -
         *)

     

       168
       168
       -
         type mailbox_query_filter = [

     

       169
       169
       -
           | `And of mailbox_query_filter list  (** Logical AND of filters *)

     

       170
       170
       -
           | `Or of mailbox_query_filter list   (** Logical OR of filters *)

     

       171
       171
       -
           | `Not of mailbox_query_filter       (** Logical NOT of a filter *)

     

       172
       172
       -
           | `Condition of mailbox_filter_condition  (** Simple condition filter *)

     

       173
       173
       -
         ]

     

       174
       174
       -
       

     

       175
       175
       -
         (** Mailbox/get request arguments as defined in RFC8621 Section 2.1.

     

       176
       176
       -
             Used to fetch mailboxes by ID.

     

       177
       177
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>

     

       178
       178
       -
         *)

     

       179
       179
       -
         type mailbox_get_arguments = {

     

       180
       180
       -
           account_id : id;  (** The account to fetch mailboxes from *)

     

       181
       181
       -
           ids : id list option;  (** The IDs of mailboxes to fetch, null means all *)

     

       182
       182
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       183
       183
       -
         }

     

       184
       184
       -
       

     

       185
       185
       -
         (** Mailbox/get response as defined in RFC8621 Section 2.1.

     

       186
       186
       -
             Contains requested mailboxes.

     

       187
       187
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>

     

       188
       188
       -
         *)

     

       189
       189
       -
         type mailbox_get_response = {

     

       190
       190
       -
           account_id : id;  (** The account from which mailboxes were fetched *)

     

       191
       191
       -
           state : string;  (** A string representing the state on the server *)

     

       192
       192
       -
           list : mailbox list;  (** The list of mailboxes requested *)

     

       193
       193
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       194
       194
       -
         }

     

       195
       195
       -
       

     

       196
       196
       -
         (** Mailbox/changes request arguments as defined in RFC8621 Section 2.2.

     

       197
       197
       -
             Used to get mailbox changes since a previous state.

     

       198
       198
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>

     

       199
       199
       -
         *)

     

       200
       200
       -
         type mailbox_changes_arguments = {

     

       201
       201
       -
           account_id : id;  (** The account to get changes for *)

     

       202
       202
       -
           since_state : string;  (** The previous state to compare to *)

     

       203
       203
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       204
       204
       -
         }

     

       205
       205
       -
       

     

       206
       206
       -
         (** Mailbox/changes response as defined in RFC8621 Section 2.2.

     

       207
       207
       -
             Reports mailboxes that have changed since a previous state.

     

       208
       208
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>

     

       209
       209
       -
         *)

     

       210
       210
       -
         type mailbox_changes_response = {

     

       211
       211
       -
           account_id : id;  (** The account changes are for *)

     

       212
       212
       -
           old_state : string;  (** The state provided in the request *)

     

       213
       213
       -
           new_state : string;  (** The current state on the server *)

     

       214
       214
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       215
       215
       -
           created : id list;  (** IDs of mailboxes created since old_state *)

     

       216
       216
       -
           updated : id list;  (** IDs of mailboxes updated since old_state *)

     

       217
       217
       -
           destroyed : id list;  (** IDs of mailboxes destroyed since old_state *)

     

       218
       218
       -
         }

     

       219
       219
       -
       

     

       220
       220
       -
         (** Mailbox/query request arguments as defined in RFC8621 Section 2.3.

     

       221
       221
       -
             Used to query mailboxes based on filter criteria.

     

       222
       222
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       223
       223
       -
         *)

     

       224
       224
       -
         type mailbox_query_arguments = {

     

       225
       225
       -
           account_id : id;  (** The account to query *)

     

       226
       226
       -
           filter : mailbox_query_filter option;  (** Filter to match mailboxes against *)

     

       227
       227
       -
           sort : [ `name | `role | `sort_order ] list option;  (** Sort criteria *)

     

       228
       228
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       229
       229
       -
         }

     

       230
       230
       -
       

     

       231
       231
       -
         (** Mailbox/query response as defined in RFC8621 Section 2.3.

     

       232
       232
       -
             Contains IDs of mailboxes matching the query.

     

       233
       233
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>

     

       234
       234
       -
         *)

     

       235
       235
       -
         type mailbox_query_response = {

     

       236
       236
       -
           account_id : id;  (** The account that was queried *)

     

       237
       237
       -
           query_state : string;  (** State string for the query results *)

     

       238
       238
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       239
       239
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       240
       240
       -
           ids : id list;  (** IDs of mailboxes matching the query *)

     

       241
       241
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       242
       242
       -
         }

     

       243
       243
       -
       

     

       244
       244
       -
         (** Mailbox/queryChanges request arguments as defined in RFC8621 Section 2.4.

     

       245
       245
       -
             Used to get changes to mailbox query results.

     

       246
       246
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       247
       247
       -
         *)

     

       248
       248
       -
         type mailbox_query_changes_arguments = {

     

       249
       249
       -
           account_id : id;  (** The account to query *)

     

       250
       250
       -
           filter : mailbox_query_filter option;  (** Same filter as the original query *)

     

       251
       251
       -
           sort : [ `name | `role | `sort_order ] list option;  (** Same sort as the original query *)

     

       252
       252
       -
           since_query_state : string;  (** The query_state from the previous result *)

     

       253
       253
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       254
       254
       -
           up_to_id : id option;  (** ID of the last mailbox to check for changes *)

     

       255
       255
       -
         }

     

       256
       256
       -
       

     

       257
       257
       -
         (** Mailbox/queryChanges response as defined in RFC8621 Section 2.4.

     

       258
       258
       -
             Reports changes to a mailbox query since the previous state.

     

       259
       259
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       260
       260
       -
         *)

     

       261
       261
       -
         type mailbox_query_changes_response = {

     

       262
       262
       -
           account_id : id;  (** The account that was queried *)

     

       263
       263
       -
           old_query_state : string;  (** The query_state from the request *)

     

       264
       264
       -
           new_query_state : string;  (** The current query_state on the server *)

     

       265
       265
       -
           total : unsigned_int option;  (** Updated total number of matches, if requested *)

     

       266
       266
       -
           removed : id list;  (** IDs that were in the old results but not the new *)

     

       267
       267
       -
           added : mailbox_query_changes_added list;  (** IDs that are in the new results but not the old *)

     

       268
       268
       -
         }

     

       269
       269
       -
       

     

       270
       270
       -
         (** Added item in mailbox query changes as defined in RFC8621 Section 2.4.

     

       271
       271
       -
             Represents a mailbox added to query results.

     

       272
       272
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>

     

       273
       273
       -
         *)

     

       274
       274
       -
         and mailbox_query_changes_added = {

     

       275
       275
       -
           id : id;  (** ID of the added mailbox *)

     

       276
       276
       -
           index : unsigned_int;  (** Zero-based index of the added mailbox in the results *)

     

       277
       277
       -
         }

     

       278
       278
       -
       

     

       279
       279
       -
         (** Mailbox/set request arguments as defined in RFC8621 Section 2.5.

     

       280
       280
       -
             Used to create, update, and destroy mailboxes.

     

       281
       281
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       282
       282
       -
         *)

     

       283
       283
       -
         type mailbox_set_arguments = {

     

       284
       284
       -
           account_id : id;  (** The account to make changes in *)

     

       285
       285
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       286
       286
       -
           create : (id * mailbox_creation) list option;  (** Map of creation IDs to mailboxes to create *)

     

       287
       287
       -
           update : (id * mailbox_update) list option;  (** Map of IDs to update properties *)

     

       288
       288
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       289
       289
       -
         }

     

       290
       290
       -
       

     

       291
       291
       -
         (** Properties for mailbox creation as defined in RFC8621 Section 2.5.

     

       292
       292
       -
             Used to create new mailboxes.

     

       293
       293
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       294
       294
       -
         *)

     

       295
       295
       -
         and mailbox_creation = {

     

       296
       296
       -
           name : string;  (** Name for the new mailbox *)

     

       297
       297
       -
           parent_id : id option;  (** ID of the parent mailbox, if any *)

     

       298
       298
       -
           role : string option;  (** Role for the mailbox, if it's a special-purpose mailbox *)

     

       299
       299
       -
           sort_order : unsigned_int option;  (** Sort order, defaults to 0 *)

     

       300
       300
       -
           is_subscribed : bool option;  (** Whether the mailbox is subscribed, defaults to true *)

     

       301
       301
       -
         }

     

       302
       302
       -
       

     

       303
       303
       -
         (** Properties for mailbox update as defined in RFC8621 Section 2.5.

     

       304
       304
       -
             Used to update existing mailboxes.

     

       305
       305
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       306
       306
       -
         *)

     

       307
       307
       -
         and mailbox_update = {

     

       308
       308
       -
           name : string option;  (** New name for the mailbox *)

     

       309
       309
       -
           parent_id : id option;  (** New parent ID for the mailbox *)

     

       310
       310
       -
           role : string option;  (** New role for the mailbox *)

     

       311
       311
       -
           sort_order : unsigned_int option;  (** New sort order for the mailbox *)

     

       312
       312
       -
           is_subscribed : bool option;  (** New subscription status for the mailbox *)

     

       313
       313
       -
         }

     

       314
       314
       -
       

     

       315
       315
       -
         (** Mailbox/set response as defined in RFC8621 Section 2.5.

     

       316
       316
       -
             Reports the results of mailbox changes.

     

       317
       317
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>

     

       318
       318
       -
         *)

     

       319
       319
       -
         type mailbox_set_response = {

     

       320
       320
       -
           account_id : id;  (** The account that was modified *)

     

       321
       321
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       322
       322
       -
           new_state : string;  (** The current state on the server *)

     

       323
       323
       -
           created : (id * mailbox) list option;  (** Map of creation IDs to created mailboxes *)

     

       324
       324
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       325
       325
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       326
       326
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       327
       327
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       328
       328
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       329
       329
       -
         }

     

       330
       330
       -
       

     

       331
       331
       -
         (** {1:thread Thread objects}

     

       332
       332
       -
             Thread types as defined in RFC8621 Section 3

     

       333
       333
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>

     

       334
       334
       -
         *)

     

       335
       335
       -
       

     

       336
       336
       -
         (** A thread in a mail account as defined in RFC8621 Section 3.

     

       337
       337
       -
             Represents a group of related email messages.

     

       338
       338
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>

     

       339
       339
       -
         *)

     

       340
       340
       -
         type thread = {

     

       341
       341
       -
           id : id;  (** Server-assigned ID for the thread *)

     

       342
       342
       -
           email_ids : id list;  (** IDs of emails in the thread *)

     

       343
       343
       -
         }

     

       344
       344
       -
       

     

       345
       345
       -
         (** Thread/get request arguments as defined in RFC8621 Section 3.1.

     

       346
       346
       -
             Used to fetch threads by ID.

     

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

     

       348
       348
       -
         *)

     

       349
       349
       -
         type thread_get_arguments = {

     

       350
       350
       -
           account_id : id;  (** The account to fetch threads from *)

     

       351
       351
       -
           ids : id list option;  (** The IDs of threads to fetch, null means all *)

     

       352
       352
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       353
       353
       -
         }

     

       354
       354
       -
       

     

       355
       355
       -
         (** Thread/get response as defined in RFC8621 Section 3.1.

     

       356
       356
       -
             Contains requested threads.

     

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

     

       358
       358
       -
         *)

     

       359
       359
       -
         type thread_get_response = {

     

       360
       360
       -
           account_id : id;  (** The account from which threads were fetched *)

     

       361
       361
       -
           state : string;  (** A string representing the state on the server *)

     

       362
       362
       -
           list : thread list;  (** The list of threads requested *)

     

       363
       363
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       364
       364
       -
         }

     

       365
       365
       -
       

     

       366
       366
       -
         (** Thread/changes request arguments as defined in RFC8621 Section 3.2.

     

       367
       367
       -
             Used to get thread changes since a previous state.

     

       368
       368
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>

     

       369
       369
       -
         *)

     

       370
       370
       -
         type thread_changes_arguments = {

     

       371
       371
       -
           account_id : id;  (** The account to get changes for *)

     

       372
       372
       -
           since_state : string;  (** The previous state to compare to *)

     

       373
       373
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       374
       374
       -
         }

     

       375
       375
       -
       

     

       376
       376
       -
         (** Thread/changes response as defined in RFC8621 Section 3.2.

     

       377
       377
       -
             Reports threads that have changed since a previous state.

     

       378
       378
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>

     

       379
       379
       -
         *)

     

       380
       380
       -
         type thread_changes_response = {

     

       381
       381
       -
           account_id : id;  (** The account changes are for *)

     

       382
       382
       -
           old_state : string;  (** The state provided in the request *)

     

       383
       383
       -
           new_state : string;  (** The current state on the server *)

     

       384
       384
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       385
       385
       -
           created : id list;  (** IDs of threads created since old_state *)

     

       386
       386
       -
           updated : id list;  (** IDs of threads updated since old_state *)

     

       387
       387
       -
           destroyed : id list;  (** IDs of threads destroyed since old_state *)

     

       388
       388
       -
         }

     

       389
       389
       -
       

     

       390
       390
       -
         (** {1:email Email objects}

     

       391
       391
       -
             Email types as defined in RFC8621 Section 4

     

       392
       392
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>

     

       393
       393
       -
         *)

     

       394
       394
       -
       

     

       395
       395
       -
         (** Addressing (mailbox) information as defined in RFC8621 Section 4.1.1.

     

       396
       396
       -
             Represents an email address with optional display name.

     

       397
       397
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1>

     

       398
       398
       -
         *)

     

       399
       399
       -
         type email_address = {

     

       400
       400
       -
           name : string option;  (** Display name of the mailbox (e.g., "John Doe") *)

     

       401
       401
       -
           email : string;  (** The email address (e.g., "john@example.com") *)

     

       402
       402
       -
           parameters : (string * string) list;  (** Additional parameters for the address *)

     

       403
       403
       -
         }

     

       404
       404
       -
       

     

       405
       405
       -
         (** Message header field as defined in RFC8621 Section 4.1.2.

     

       406
       406
       -
             Represents an email header.

     

       407
       407
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.2>

     

       408
       408
       -
         *)

     

       409
       409
       -
         type header = {

     

       410
       410
       -
           name : string;  (** Name of the header field (e.g., "Subject") *)

     

       411
       411
       -
           value : string;  (** Value of the header field *)

     

       412
       412
       -
         }

     

       413
       413
       -
       

     

       414
       414
       -
         (** Email keyword (flag) as defined in RFC8621 Section 4.3.

     

       415
       415
       -
             Represents a flag or tag on an email message.

     

       416
       416
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.3>

     

       417
       417
       -
         *)

     

       418
       418
       -
         type keyword =

     

       419
       419
       -
           | Flagged    (** Message is flagged/starred *)

     

       420
       420
       -
           | Answered   (** Message has been replied to *)

     

       421
       421
       -
           | Draft      (** Message is a draft *)

     

       422
       422
       -
           | Forwarded  (** Message has been forwarded *)

     

       423
       423
       -
           | Phishing   (** Message has been reported as phishing *)

     

       424
       424
       -
           | Junk       (** Message is spam/junk *)

     

       425
       425
       -
           | NotJunk    (** Message is explicitly not spam *)

     

       426
       426
       -
           | Seen       (** Message has been read *)

     

       427
       427
       -
           | Unread     (** Message is unread (inverse of $seen) *)

     

       428
       428
       -
           | Custom of string  (** Custom/non-standard keywords *)

     

       429
       429
       -
         

     

       430
       430
       -
         (** Email message as defined in RFC8621 Section 4.

     

       431
       431
       -
             Represents an email message in a mail account.

     

       432
       432
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>

     

       433
       433
       -
         *)

     

       434
       434
       -
         type email = {

     

       435
       435
       -
           id : id;  (** Server-assigned ID for the message *)

     

       436
       436
       -
           blob_id : id;  (** ID of the raw message content blob *)

     

       437
       437
       -
           thread_id : id;  (** ID of the thread this message belongs to *)

     

       438
       438
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       439
       439
       -
           keywords : (keyword * bool) list;  (** Map of keywords to boolean (whether message has keyword) *)

     

       440
       440
       -
           size : unsigned_int;  (** Size of the message in octets *)

     

       441
       441
       -
           received_at : utc_date;  (** When the message was received by the server *)

     

       442
       442
       -
           message_id : string list;  (** Message-ID header values *)

     

       443
       443
       -
           in_reply_to : string list option;  (** In-Reply-To header values *)

     

       444
       444
       -
           references : string list option;  (** References header values *)

     

       445
       445
       -
           sender : email_address list option;  (** Sender header addresses *)

     

       446
       446
       -
           from : email_address list option;  (** From header addresses *)

     

       447
       447
       -
           to_ : email_address list option;  (** To header addresses *)

     

       448
       448
       -
           cc : email_address list option;  (** Cc header addresses *)

     

       449
       449
       -
           bcc : email_address list option;  (** Bcc header addresses *)

     

       450
       450
       -
           reply_to : email_address list option;  (** Reply-To header addresses *)

     

       451
       451
       -
           subject : string option;  (** Subject header value *)

     

       452
       452
       -
           sent_at : utc_date option;  (** Date header value as a date-time *)

     

       453
       453
       -
           has_attachment : bool option;  (** Does the message have any attachments *)

     

       454
       454
       -
           preview : string option;  (** Preview of the message (first bit of text) *)

     

       455
       455
       -
           body_values : (string * string) list option;  (** Map of part IDs to text content *)

     

       456
       456
       -
           text_body : email_body_part list option;  (** Plain text message body parts *)

     

       457
       457
       -
           html_body : email_body_part list option;  (** HTML message body parts *)

     

       458
       458
       -
           attachments : email_body_part list option;  (** Attachment parts in the message *)

     

       459
       459
       -
           headers : header list option;  (** All headers in the message *)

     

       460
       460
       -
         }

     

       461
       461
       -
       

     

       462
       462
       -
         (** Email body part as defined in RFC8621 Section 4.1.4.

     

       463
       463
       -
             Represents a MIME part in an email message.

     

       464
       464
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.4>

     

       465
       465
       -
         *)

     

       466
       466
       -
         and email_body_part = {

     

       467
       467
       -
           part_id : string option;  (** Server-assigned ID for the MIME part *)

     

       468
       468
       -
           blob_id : id option;  (** ID of the raw content for this part *)

     

       469
       469
       -
           size : unsigned_int option;  (** Size of the part in octets *)

     

       470
       470
       -
           headers : header list option;  (** Headers for this MIME part *)

     

       471
       471
       -
           name : string option;  (** Filename of this part, if any *)

     

       472
       472
       -
           type_ : string option;  (** MIME type of the part *)

     

       473
       473
       -
           charset : string option;  (** Character set of the part, if applicable *)

     

       474
       474
       -
           disposition : string option;  (** Content-Disposition value *)

     

       475
       475
       -
           cid : string option;  (** Content-ID value *)

     

       476
       476
       -
           language : string list option;  (** Content-Language values *)

     

       477
       477
       -
           location : string option;  (** Content-Location value *)

     

       478
       478
       -
           sub_parts : email_body_part list option;  (** Child MIME parts for multipart types *)

     

       479
       479
       -
           header_parameter_name : string option;  (** Header parameter name (for headers with parameters) *)

     

       480
       480
       -
           header_parameter_value : string option;  (** Header parameter value (for headers with parameters) *)

     

       481
       481
       -
         }

     

       482
       482
       -
         

     

       483
       483
       -
         (** Email query filter condition as defined in RFC8621 Section 4.4.

     

       484
       484
       -
             Specifies conditions for filtering emails in queries.

     

       485
       485
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       486
       486
       -
         *)

     

       487
       487
       -
         type email_filter_condition = {

     

       488
       488
       -
           in_mailbox : id option;  (** Only include emails in this mailbox *)

     

       489
       489
       -
           in_mailbox_other_than : id list option;  (** Only include emails not in these mailboxes *)

     

       490
       490
       -
           min_size : unsigned_int option;  (** Only include emails of at least this size in octets *)

     

       491
       491
       -
           max_size : unsigned_int option;  (** Only include emails of at most this size in octets *)

     

       492
       492
       -
           before : utc_date option;  (** Only include emails received before this date-time *)

     

       493
       493
       -
           after : utc_date option;  (** Only include emails received after this date-time *)

     

       494
       494
       -
           header : (string * string) option;  (** Only include emails with header matching value (name, value) *)

     

       495
       495
       -
           from : string option;  (** Only include emails with From containing this text *)

     

       496
       496
       -
           to_ : string option;  (** Only include emails with To containing this text *)

     

       497
       497
       -
           cc : string option;  (** Only include emails with CC containing this text *)

     

       498
       498
       -
           bcc : string option;  (** Only include emails with BCC containing this text *)

     

       499
       499
       -
           subject : string option;  (** Only include emails with Subject containing this text *)

     

       500
       500
       -
           body : string option;  (** Only include emails with body containing this text *)

     

       501
       501
       -
           has_keyword : string option;  (** Only include emails with this keyword *)

     

       502
       502
       -
           not_keyword : string option;  (** Only include emails without this keyword *)

     

       503
       503
       -
           has_attachment : bool option;  (** If true, only include emails with attachments *)

     

       504
       504
       -
           text : string option;  (** Only include emails with this text in headers or body *)

     

       505
       505
       -
         }

     

       506
       506
       -
       

     

       507
       507
       -
         (** Filter for email queries as defined in RFC8621 Section 4.4.

     

       508
       508
       -
             Complex filter for Email/query method.

     

       509
       509
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       510
       510
       -
         *)

     

       511
       511
       -
         type email_query_filter = [

     

       512
       512
       -
           | `And of email_query_filter list  (** Logical AND of filters *)

     

       513
       513
       -
           | `Or of email_query_filter list   (** Logical OR of filters *)

     

       514
       514
       -
           | `Not of email_query_filter       (** Logical NOT of a filter *)

     

       515
       515
       -
           | `Condition of email_filter_condition  (** Simple condition filter *)

     

       516
       516
       -
         ]

     

       517
       517
       -
       

     

       518
       518
       -
         (** Email/get request arguments as defined in RFC8621 Section 4.5.

     

       519
       519
       -
             Used to fetch emails by ID.

     

       520
       520
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>

     

       521
       521
       -
         *)

     

       522
       522
       -
         type email_get_arguments = {

     

       523
       523
       -
           account_id : id;  (** The account to fetch emails from *)

     

       524
       524
       -
           ids : id list option;  (** The IDs of emails to fetch, null means all *)

     

       525
       525
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       526
       526
       -
           body_properties : string list option;  (** Properties to return on body parts *)

     

       527
       527
       -
           fetch_text_body_values : bool option;  (** Whether to fetch text body content *)

     

       528
       528
       -
           fetch_html_body_values : bool option;  (** Whether to fetch HTML body content *)

     

       529
       529
       -
           fetch_all_body_values : bool option;  (** Whether to fetch all body content *)

     

       530
       530
       -
           max_body_value_bytes : unsigned_int option;  (** Maximum size of body values to return *)

     

       531
       531
       -
         }

     

       532
       532
       -
       

     

       533
       533
       -
         (** Email/get response as defined in RFC8621 Section 4.5.

     

       534
       534
       -
             Contains requested emails.

     

       535
       535
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>

     

       536
       536
       -
         *)

     

       537
       537
       -
         type email_get_response = {

     

       538
       538
       -
           account_id : id;  (** The account from which emails were fetched *)

     

       539
       539
       -
           state : string;  (** A string representing the state on the server *)

     

       540
       540
       -
           list : email list;  (** The list of emails requested *)

     

       541
       541
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       542
       542
       -
         }

     

       543
       543
       -
       

     

       544
       544
       -
         (** Email/changes request arguments as defined in RFC8621 Section 4.6.

     

       545
       545
       -
             Used to get email changes since a previous state.

     

       546
       546
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>

     

       547
       547
       -
         *)

     

       548
       548
       -
         type email_changes_arguments = {

     

       549
       549
       -
           account_id : id;  (** The account to get changes for *)

     

       550
       550
       -
           since_state : string;  (** The previous state to compare to *)

     

       551
       551
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       552
       552
       -
         }

     

       553
       553
       -
       

     

       554
       554
       -
         (** Email/changes response as defined in RFC8621 Section 4.6.

     

       555
       555
       -
             Reports emails that have changed since a previous state.

     

       556
       556
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>

     

       557
       557
       -
         *)

     

       558
       558
       -
         type email_changes_response = {

     

       559
       559
       -
           account_id : id;  (** The account changes are for *)

     

       560
       560
       -
           old_state : string;  (** The state provided in the request *)

     

       561
       561
       -
           new_state : string;  (** The current state on the server *)

     

       562
       562
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       563
       563
       -
           created : id list;  (** IDs of emails created since old_state *)

     

       564
       564
       -
           updated : id list;  (** IDs of emails updated since old_state *)

     

       565
       565
       -
           destroyed : id list;  (** IDs of emails destroyed since old_state *)

     

       566
       566
       -
         }

     

       567
       567
       -
       

     

       568
       568
       -
         (** Email/query request arguments as defined in RFC8621 Section 4.4.

     

       569
       569
       -
             Used to query emails based on filter criteria.

     

       570
       570
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       571
       571
       -
         *)

     

       572
       572
       -
         type email_query_arguments = {

     

       573
       573
       -
           account_id : id;  (** The account to query *)

     

       574
       574
       -
           filter : email_query_filter option;  (** Filter to match emails against *)

     

       575
       575
       -
           sort : comparator list option;  (** Sort criteria *)

     

       576
       576
       -
           collapse_threads : bool option;  (** Whether to collapse threads in the results *)

     

       577
       577
       -
           position : unsigned_int option;  (** Zero-based index of first result to return *)

     

       578
       578
       -
           anchor : id option;  (** ID of email to use as reference point *)

     

       579
       579
       -
           anchor_offset : int_t option;  (** Offset from anchor to start returning results *)

     

       580
       580
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       581
       581
       -
           calculate_total : bool option;  (** Whether to calculate the total number of matching emails *)

     

       582
       582
       -
         }

     

       583
       583
       -
       

     

       584
       584
       -
         (** Email/query response as defined in RFC8621 Section 4.4.

     

       585
       585
       -
             Contains IDs of emails matching the query.

     

       586
       586
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>

     

       587
       587
       -
         *)

     

       588
       588
       -
         type email_query_response = {

     

       589
       589
       -
           account_id : id;  (** The account that was queried *)

     

       590
       590
       -
           query_state : string;  (** State string for the query results *)

     

       591
       591
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       592
       592
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       593
       593
       -
           ids : id list;  (** IDs of emails matching the query *)

     

       594
       594
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       595
       595
       -
           thread_ids : id list option;  (** IDs of threads if collapse_threads was true *)

     

       596
       596
       -
         }

     

       597
       597
       -
       

     

       598
       598
       -
         (** Email/queryChanges request arguments as defined in RFC8621 Section 4.7.

     

       599
       599
       -
             Used to get changes to email query results.

     

       600
       600
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       601
       601
       -
         *)

     

       602
       602
       -
         type email_query_changes_arguments = {

     

       603
       603
       -
           account_id : id;  (** The account to query *)

     

       604
       604
       -
           filter : email_query_filter option;  (** Same filter as the original query *)

     

       605
       605
       -
           sort : comparator list option;  (** Same sort as the original query *)

     

       606
       606
       -
           collapse_threads : bool option;  (** Same collapse_threads as the original query *)

     

       607
       607
       -
           since_query_state : string;  (** The query_state from the previous result *)

     

       608
       608
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       609
       609
       -
           up_to_id : id option;  (** ID of the last email to check for changes *)

     

       610
       610
       -
         }

     

       611
       611
       -
       

     

       612
       612
       -
         (** Email/queryChanges response as defined in RFC8621 Section 4.7.

     

       613
       613
       -
             Reports changes to an email query since the previous state.

     

       614
       614
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       615
       615
       -
         *)

     

       616
       616
       -
         type email_query_changes_response = {

     

       617
       617
       -
           account_id : id;  (** The account that was queried *)

     

       618
       618
       -
           old_query_state : string;  (** The query_state from the request *)

     

       619
       619
       -
           new_query_state : string;  (** The current query_state on the server *)

     

       620
       620
       -
           total : unsigned_int option;  (** Updated total number of matches, if requested *)

     

       621
       621
       -
           removed : id list;  (** IDs that were in the old results but not the new *)

     

       622
       622
       -
           added : email_query_changes_added list;  (** IDs that are in the new results but not the old *)

     

       623
       623
       -
         }

     

       624
       624
       -
       

     

       625
       625
       -
         (** Added item in email query changes as defined in RFC8621 Section 4.7.

     

       626
       626
       -
             Represents an email added to query results.

     

       627
       627
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>

     

       628
       628
       -
         *)

     

       629
       629
       -
         and email_query_changes_added = {

     

       630
       630
       -
           id : id;  (** ID of the added email *)

     

       631
       631
       -
           index : unsigned_int;  (** Zero-based index of the added email in the results *)

     

       632
       632
       -
         }

     

       633
       633
       -
       

     

       634
       634
       -
         (** Email/set request arguments as defined in RFC8621 Section 4.8.

     

       635
       635
       -
             Used to create, update, and destroy emails.

     

       636
       636
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       637
       637
       -
         *)

     

       638
       638
       -
         type email_set_arguments = {

     

       639
       639
       -
           account_id : id;  (** The account to make changes in *)

     

       640
       640
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       641
       641
       -
           create : (id * email_creation) list option;  (** Map of creation IDs to emails to create *)

     

       642
       642
       -
           update : (id * email_update) list option;  (** Map of IDs to update properties *)

     

       643
       643
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       644
       644
       -
         }

     

       645
       645
       -
       

     

       646
       646
       -
         (** Properties for email creation as defined in RFC8621 Section 4.8.

     

       647
       647
       -
             Used to create new emails.

     

       648
       648
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       649
       649
       -
         *)

     

       650
       650
       -
         and email_creation = {

     

       651
       651
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       652
       652
       -
           keywords : (keyword * bool) list option;  (** Map of keywords to boolean (whether message has keyword) *)

     

       653
       653
       -
           received_at : utc_date option;  (** When the message was received by the server *)

     

       654
       654
       -
           message_id : string list option;  (** Message-ID header values *)

     

       655
       655
       -
           in_reply_to : string list option;  (** In-Reply-To header values *)

     

       656
       656
       -
           references : string list option;  (** References header values *)

     

       657
       657
       -
           sender : email_address list option;  (** Sender header addresses *)

     

       658
       658
       -
           from : email_address list option;  (** From header addresses *)

     

       659
       659
       -
           to_ : email_address list option;  (** To header addresses *)

     

       660
       660
       -
           cc : email_address list option;  (** Cc header addresses *)

     

       661
       661
       -
           bcc : email_address list option;  (** Bcc header addresses *)

     

       662
       662
       -
           reply_to : email_address list option;  (** Reply-To header addresses *)

     

       663
       663
       -
           subject : string option;  (** Subject header value *)

     

       664
       664
       -
           body_values : (string * string) list option;  (** Map of part IDs to text content *)

     

       665
       665
       -
           text_body : email_body_part list option;  (** Plain text message body parts *)

     

       666
       666
       -
           html_body : email_body_part list option;  (** HTML message body parts *)

     

       667
       667
       -
           attachments : email_body_part list option;  (** Attachment parts in the message *)

     

       668
       668
       -
           headers : header list option;  (** All headers in the message *)

     

       669
       669
       -
         }

     

       670
       670
       -
       

     

       671
       671
       -
         (** Properties for email update as defined in RFC8621 Section 4.8.

     

       672
       672
       -
             Used to update existing emails.

     

       673
       673
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       674
       674
       -
         *)

     

       675
       675
       -
         and email_update = {

     

       676
       676
       -
           keywords : (keyword * bool) list option;  (** New keywords to set on the email *)

     

       677
       677
       -
           mailbox_ids : (id * bool) list option;  (** New mailboxes to set for the email *)

     

       678
       678
       -
         }

     

       679
       679
       -
       

     

       680
       680
       -
         (** Email/set response as defined in RFC8621 Section 4.8.

     

       681
       681
       -
             Reports the results of email changes.

     

       682
       682
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>

     

       683
       683
       -
         *)

     

       684
       684
       -
         type email_set_response = {

     

       685
       685
       -
           account_id : id;  (** The account that was modified *)

     

       686
       686
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       687
       687
       -
           new_state : string;  (** The current state on the server *)

     

       688
       688
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       689
       689
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       690
       690
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       691
       691
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       692
       692
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       693
       693
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       694
       694
       -
         }

     

       695
       695
       -
       

     

       696
       696
       -
         (** Email/copy request arguments as defined in RFC8621 Section 4.9.

     

       697
       697
       -
             Used to copy emails between accounts.

     

       698
       698
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>

     

       699
       699
       -
         *)

     

       700
       700
       -
         type email_copy_arguments = {

     

       701
       701
       -
           from_account_id : id;  (** The account to copy emails from *)

     

       702
       702
       -
           account_id : id;  (** The account to copy emails to *)

     

       703
       703
       -
           create : (id * email_creation) list;  (** Map of creation IDs to email creation properties *)

     

       704
       704
       -
           on_success_destroy_original : bool option;  (** Whether to destroy originals after copying *)

     

       705
       705
       -
         }

     

       706
       706
       -
       

     

       707
       707
       -
         (** Email/copy response as defined in RFC8621 Section 4.9.

     

       708
       708
       -
             Reports the results of copying emails.

     

       709
       709
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>

     

       710
       710
       -
         *)

     

       711
       711
       -
         type email_copy_response = {

     

       712
       712
       -
           from_account_id : id;  (** The account emails were copied from *)

     

       713
       713
       -
           account_id : id;  (** The account emails were copied to *)

     

       714
       714
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       715
       715
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed copies *)

     

       716
       716
       -
         }

     

       717
       717
       -
       

     

       718
       718
       -
         (** Email/import request arguments as defined in RFC8621 Section 4.10.

     

       719
       719
       -
             Used to import raw emails from blobs.

     

       720
       720
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       721
       721
       -
         *)

     

       722
       722
       -
         type email_import_arguments = {

     

       723
       723
       -
           account_id : id;  (** The account to import emails into *)

     

       724
       724
       -
           emails : (id * email_import) list;  (** Map of creation IDs to import properties *)

     

       725
       725
       -
         }

     

       726
       726
       -
       

     

       727
       727
       -
         (** Properties for email import as defined in RFC8621 Section 4.10.

     

       728
       728
       -
             Used to import raw emails from blobs.

     

       729
       729
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       730
       730
       -
         *)

     

       731
       731
       -
         and email_import = {

     

       732
       732
       -
           blob_id : id;  (** ID of the blob containing the raw message *)

     

       733
       733
       -
           mailbox_ids : (id * bool) list;  (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)

     

       734
       734
       -
           keywords : (keyword * bool) list option;  (** Map of keywords to boolean (whether message has keyword) *)

     

       735
       735
       -
           received_at : utc_date option;  (** When the message was received, defaults to now *)

     

       736
       736
       -
         }

     

       737
       737
       -
       

     

       738
       738
       -
         (** Email/import response as defined in RFC8621 Section 4.10.

     

       739
       739
       -
             Reports the results of importing emails.

     

       740
       740
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>

     

       741
       741
       -
         *)

     

       742
       742
       -
         type email_import_response = {

     

       743
       743
       -
           account_id : id;  (** The account emails were imported into *)

     

       744
       744
       -
           created : (id * email) list option;  (** Map of creation IDs to created emails *)

     

       745
       745
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed imports *)

     

       746
       746
       -
         }

     

       747
       747
       -
       

     

       748
       748
       -
         (** {1:search_snippet Search snippets}

     

       749
       749
       -
             Search snippet types as defined in RFC8621 Section 4.11

     

       750
       750
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       751
       751
       -
         *)

     

       752
       752
       -
       

     

       753
       753
       -
         (** SearchSnippet/get request arguments as defined in RFC8621 Section 4.11.

     

       754
       754
       -
             Used to get highlighted snippets from emails matching a search.

     

       755
       755
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       756
       756
       -
         *)

     

       757
       757
       -
         type search_snippet_get_arguments = {

     

       758
       758
       -
           account_id : id;  (** The account to search in *)

     

       759
       759
       -
           email_ids : id list;  (** The IDs of emails to get snippets for *)

     

       760
       760
       -
           filter : email_filter_condition;  (** Filter containing the text to find and highlight *)

     

       761
       761
       -
         }

     

       762
       762
       -
       

     

       763
       763
       -
         (** SearchSnippet/get response as defined in RFC8621 Section 4.11.

     

       764
       764
       -
             Contains search result snippets with highlighted text.

     

       765
       765
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       766
       766
       -
         *)

     

       767
       767
       -
         type search_snippet_get_response = {

     

       768
       768
       -
           account_id : id;  (** The account that was searched *)

     

       769
       769
       -
           list : (id * search_snippet) list;  (** Map of email IDs to their search snippets *)

     

       770
       770
       -
           not_found : id list;  (** IDs for which no snippet could be generated *)

     

       771
       771
       -
         }

     

       772
       772
       -
       

     

       773
       773
       -
         (** Search snippet for an email as defined in RFC8621 Section 4.11.

     

       774
       774
       -
             Contains highlighted parts of emails matching a search.

     

       775
       775
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>

     

       776
       776
       -
         *)

     

       777
       777
       -
         and search_snippet = {

     

       778
       778
       -
           subject : string option;  (** Subject with search terms highlighted *)

     

       779
       779
       -
           preview : string option;  (** Email body preview with search terms highlighted *)

     

       780
       780
       -
         }

     

       781
       781
       -
       

     

       782
       782
       -
         (** {1:submission EmailSubmission objects}

     

       783
       783
       -
             Email submission types as defined in RFC8621 Section 5

     

       784
       784
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5>

     

       785
       785
       -
         *)

     

       786
       786
       -
       

     

       787
       787
       -
         (** EmailSubmission address as defined in RFC8621 Section 5.1.

     

       788
       788
       -
             Represents an email address for mail submission.

     

       789
       789
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       790
       790
       -
         *)

     

       791
       791
       -
         type submission_address = {

     

       792
       792
       -
           email : string;  (** The email address (e.g., "john@example.com") *)

     

       793
       793
       -
           parameters : (string * string) list option;  (** SMTP extension parameters *)

     

       794
       794
       -
         }

     

       795
       795
       -
       

     

       796
       796
       -
         (** Email submission object as defined in RFC8621 Section 5.1.

     

       797
       797
       -
             Represents an email that has been or will be sent.

     

       798
       798
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       799
       799
       -
         *)

     

       800
       800
       -
         type email_submission = {

     

       801
       801
       -
           id : id;  (** Server-assigned ID for the submission *)

     

       802
       802
       -
           identity_id : id;  (** ID of the identity used to send the email *)

     

       803
       803
       -
           email_id : id;  (** ID of the email to send *)

     

       804
       804
       -
           thread_id : id;  (** ID of the thread containing the message *)

     

       805
       805
       -
           envelope : envelope option;  (** SMTP envelope for the message *)

     

       806
       806
       -
           send_at : utc_date option;  (** When to send the email, null for immediate *)

     

       807
       807
       -
           undo_status : [

     

       808
       808
       -
             | `pending  (** Submission can still be canceled *)

     

       809
       809
       -
             | `final    (** Submission can no longer be canceled *)

     

       810
       810
       -
             | `canceled (** Submission was canceled *)

     

       811
       811
       -
           ] option;  (** Current undo status of the submission *)

     

       812
       812
       -
           delivery_status : (string * submission_status) list option;  (** Map of recipient to delivery status *)

     

       813
       813
       -
           dsn_blob_ids : (string * id) list option;  (** Map of recipient to DSN blob ID *)

     

       814
       814
       -
           mdn_blob_ids : (string * id) list option;  (** Map of recipient to MDN blob ID *)

     

       815
       815
       -
         }

     

       816
       816
       -
       

     

       817
       817
       -
         (** Envelope for mail submission as defined in RFC8621 Section 5.1.

     

       818
       818
       -
             Represents the SMTP envelope for a message.

     

       819
       819
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       820
       820
       -
         *)

     

       821
       821
       -
         and envelope = {

     

       822
       822
       -
           mail_from : submission_address;  (** Return path for the message *)

     

       823
       823
       -
           rcpt_to : submission_address list;  (** Recipients for the message *)

     

       824
       824
       -
         }

     

       825
       825
       -
       

     

       826
       826
       -
         (** Delivery status for submitted email as defined in RFC8621 Section 5.1.

     

       827
       827
       -
             Represents the SMTP status of a delivery attempt.

     

       828
       828
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>

     

       829
       829
       -
         *)

     

       830
       830
       -
         and submission_status = {

     

       831
       831
       -
           smtp_reply : string;  (** SMTP response from the server *)

     

       832
       832
       -
           delivered : string option;  (** Timestamp when message was delivered, if successful *)

     

       833
       833
       -
         }

     

       834
       834
       -
       

     

       835
       835
       -
         (** EmailSubmission/get request arguments as defined in RFC8621 Section 5.3.

     

       836
       836
       -
             Used to fetch email submissions by ID.

     

       837
       837
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>

     

       838
       838
       -
         *)

     

       839
       839
       -
         type email_submission_get_arguments = {

     

       840
       840
       -
           account_id : id;  (** The account to fetch submissions from *)

     

       841
       841
       -
           ids : id list option;  (** The IDs of submissions to fetch, null means all *)

     

       842
       842
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       843
       843
       -
         }

     

       844
       844
       -
       

     

       845
       845
       -
         (** EmailSubmission/get response as defined in RFC8621 Section 5.3.

     

       846
       846
       -
             Contains requested email submissions.

     

       847
       847
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>

     

       848
       848
       -
         *)

     

       849
       849
       -
         type email_submission_get_response = {

     

       850
       850
       -
           account_id : id;  (** The account from which submissions were fetched *)

     

       851
       851
       -
           state : string;  (** A string representing the state on the server *)

     

       852
       852
       -
           list : email_submission list;  (** The list of submissions requested *)

     

       853
       853
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       854
       854
       -
         }

     

       855
       855
       -
       

     

       856
       856
       -
         (** EmailSubmission/changes request arguments as defined in RFC8621 Section 5.4.

     

       857
       857
       -
             Used to get submission changes since a previous state.

     

       858
       858
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>

     

       859
       859
       -
         *)

     

       860
       860
       -
         type email_submission_changes_arguments = {

     

       861
       861
       -
           account_id : id;  (** The account to get changes for *)

     

       862
       862
       -
           since_state : string;  (** The previous state to compare to *)

     

       863
       863
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       864
       864
       -
         }

     

       865
       865
       -
       

     

       866
       866
       -
         (** EmailSubmission/changes response as defined in RFC8621 Section 5.4.

     

       867
       867
       -
             Reports submissions that have changed since a previous state.

     

       868
       868
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>

     

       869
       869
       -
         *)

     

       870
       870
       -
         type email_submission_changes_response = {

     

       871
       871
       -
           account_id : id;  (** The account changes are for *)

     

       872
       872
       -
           old_state : string;  (** The state provided in the request *)

     

       873
       873
       -
           new_state : string;  (** The current state on the server *)

     

       874
       874
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       875
       875
       -
           created : id list;  (** IDs of submissions created since old_state *)

     

       876
       876
       -
           updated : id list;  (** IDs of submissions updated since old_state *)

     

       877
       877
       -
           destroyed : id list;  (** IDs of submissions destroyed since old_state *)

     

       878
       878
       -
         }

     

       879
       879
       -
       

     

       880
       880
       -
         (** EmailSubmission/query filter condition as defined in RFC8621 Section 5.5.

     

       881
       881
       -
             Specifies conditions for filtering email submissions in queries.

     

       882
       882
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       883
       883
       -
         *)

     

       884
       884
       -
         type email_submission_filter_condition = {

     

       885
       885
       -
           identity_id : id option;  (** Only include submissions with this identity *)

     

       886
       886
       -
           email_id : id option;  (** Only include submissions for this email *)

     

       887
       887
       -
           thread_id : id option;  (** Only include submissions for emails in this thread *)

     

       888
       888
       -
           before : utc_date option;  (** Only include submissions created before this date-time *)

     

       889
       889
       -
           after : utc_date option;  (** Only include submissions created after this date-time *)

     

       890
       890
       -
           subject : string option;  (** Only include submissions with matching subjects *)

     

       891
       891
       -
         }

     

       892
       892
       -
       

     

       893
       893
       -
         (** Filter for email submission queries as defined in RFC8621 Section 5.5.

     

       894
       894
       -
             Complex filter for EmailSubmission/query method.

     

       895
       895
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       896
       896
       -
         *)

     

       897
       897
       -
         type email_submission_query_filter = [

     

       898
       898
       -
           | `And of email_submission_query_filter list  (** Logical AND of filters *)

     

       899
       899
       -
           | `Or of email_submission_query_filter list   (** Logical OR of filters *)

     

       900
       900
       -
           | `Not of email_submission_query_filter       (** Logical NOT of a filter *)

     

       901
       901
       -
           | `Condition of email_submission_filter_condition  (** Simple condition filter *)

     

       902
       902
       -
         ]

     

       903
       903
       -
       

     

       904
       904
       -
         (** EmailSubmission/query request arguments as defined in RFC8621 Section 5.5.

     

       905
       905
       -
             Used to query email submissions based on filter criteria.

     

       906
       906
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       907
       907
       -
         *)

     

       908
       908
       -
         type email_submission_query_arguments = {

     

       909
       909
       -
           account_id : id;  (** The account to query *)

     

       910
       910
       -
           filter : email_submission_query_filter option;  (** Filter to match submissions against *)

     

       911
       911
       -
           sort : comparator list option;  (** Sort criteria *)

     

       912
       912
       -
           position : unsigned_int option;  (** Zero-based index of first result to return *)

     

       913
       913
       -
           anchor : id option;  (** ID of submission to use as reference point *)

     

       914
       914
       -
           anchor_offset : int_t option;  (** Offset from anchor to start returning results *)

     

       915
       915
       -
           limit : unsigned_int option;  (** Maximum number of results to return *)

     

       916
       916
       -
           calculate_total : bool option;  (** Whether to calculate the total number of matching submissions *)

     

       917
       917
       -
         }

     

       918
       918
       -
       

     

       919
       919
       -
         (** EmailSubmission/query response as defined in RFC8621 Section 5.5.

     

       920
       920
       -
             Contains IDs of email submissions matching the query.

     

       921
       921
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>

     

       922
       922
       -
         *)

     

       923
       923
       -
         type email_submission_query_response = {

     

       924
       924
       -
           account_id : id;  (** The account that was queried *)

     

       925
       925
       -
           query_state : string;  (** State string for the query results *)

     

       926
       926
       -
           can_calculate_changes : bool;  (** Whether queryChanges can be used with these results *)

     

       927
       927
       -
           position : unsigned_int;  (** Zero-based index of the first result *)

     

       928
       928
       -
           ids : id list;  (** IDs of email submissions matching the query *)

     

       929
       929
       -
           total : unsigned_int option;  (** Total number of matches if requested *)

     

       930
       930
       -
         }

     

       931
       931
       -
       

     

       932
       932
       -
         (** EmailSubmission/set request arguments as defined in RFC8621 Section 5.6.

     

       933
       933
       -
             Used to create, update, and destroy email submissions.

     

       934
       934
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       935
       935
       -
         *)

     

       936
       936
       -
         type email_submission_set_arguments = {

     

       937
       937
       -
           account_id : id;  (** The account to make changes in *)

     

       938
       938
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       939
       939
       -
           create : (id * email_submission_creation) list option;  (** Map of creation IDs to submissions to create *)

     

       940
       940
       -
           update : (id * email_submission_update) list option;  (** Map of IDs to update properties *)

     

       941
       941
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       942
       942
       -
           on_success_update_email : (id * email_update) list option;  (** Emails to update if submissions succeed *)

     

       943
       943
       -
         }

     

       944
       944
       -
       

     

       945
       945
       -
         (** Properties for email submission creation as defined in RFC8621 Section 5.6.

     

       946
       946
       -
             Used to create new email submissions.

     

       947
       947
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       948
       948
       -
         *)

     

       949
       949
       -
         and email_submission_creation = {

     

       950
       950
       -
           email_id : id;  (** ID of the email to send *)

     

       951
       951
       -
           identity_id : id;  (** ID of the identity to send from *)

     

       952
       952
       -
           envelope : envelope option;  (** Custom envelope, if needed *)

     

       953
       953
       -
           send_at : utc_date option;  (** When to send the email, defaults to now *)

     

       954
       954
       -
         }

     

       955
       955
       -
       

     

       956
       956
       -
         (** Properties for email submission update as defined in RFC8621 Section 5.6.

     

       957
       957
       -
             Used to update existing email submissions.

     

       958
       958
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       959
       959
       -
         *)

     

       960
       960
       -
         and email_submission_update = {

     

       961
       961
       -
           email_id : id option;  (** New email ID to use for this submission *)

     

       962
       962
       -
           identity_id : id option;  (** New identity ID to use for this submission *)

     

       963
       963
       -
           envelope : envelope option;  (** New envelope to use for this submission *)

     

       964
       964
       -
           undo_status : [`canceled] option;  (** Set to cancel a pending submission *)

     

       965
       965
       -
         }

     

       966
       966
       -
       

     

       967
       967
       -
         (** EmailSubmission/set response as defined in RFC8621 Section 5.6.

     

       968
       968
       -
             Reports the results of email submission changes.

     

       969
       969
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>

     

       970
       970
       -
         *)

     

       971
       971
       -
         type email_submission_set_response = {

     

       972
       972
       -
           account_id : id;  (** The account that was modified *)

     

       973
       973
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       974
       974
       -
           new_state : string;  (** The current state on the server *)

     

       975
       975
       -
           created : (id * email_submission) list option;  (** Map of creation IDs to created submissions *)

     

       976
       976
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       977
       977
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       978
       978
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       979
       979
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       980
       980
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       981
       981
       -
         }

     

       982
       982
       -
       

     

       983
       983
       -
         (** {1:identity Identity objects}

     

       984
       984
       -
             Identity types as defined in RFC8621 Section 6

     

       985
       985
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>

     

       986
       986
       -
         *)

     

       987
       987
       -
       

     

       988
       988
       -
         (** Identity for sending mail as defined in RFC8621 Section 6.

     

       989
       989
       -
             Represents an email identity that can be used to send messages.

     

       990
       990
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>

     

       991
       991
       -
         *)

     

       992
       992
       -
         type identity = {

     

       993
       993
       -
           id : id;  (** Server-assigned ID for the identity *)

     

       994
       994
       -
           name : string;  (** Display name for the identity *)

     

       995
       995
       -
           email : string;  (** Email address for the identity *)

     

       996
       996
       -
           reply_to : email_address list option;  (** Reply-To addresses to use when sending *)

     

       997
       997
       -
           bcc : email_address list option;  (** BCC addresses to automatically include *)

     

       998
       998
       -
           text_signature : string option;  (** Plain text signature for the identity *)

     

       999
       999
       -
           html_signature : string option;  (** HTML signature for the identity *)

     

       1000
       1000
       -
           may_delete : bool;  (** Whether this identity can be deleted *)

     

       1001
       1001
       -
         }

     

       1002
       1002
       -
       

     

       1003
       1003
       -
         (** Identity/get request arguments as defined in RFC8621 Section 6.1.

     

       1004
       1004
       -
             Used to fetch identities by ID.

     

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

     

       1006
       1006
       -
         *)

     

       1007
       1007
       -
         type identity_get_arguments = {

     

       1008
       1008
       -
           account_id : id;  (** The account to fetch identities from *)

     

       1009
       1009
       -
           ids : id list option;  (** The IDs of identities to fetch, null means all *)

     

       1010
       1010
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       1011
       1011
       -
         }

     

       1012
       1012
       -
       

     

       1013
       1013
       -
         (** Identity/get response as defined in RFC8621 Section 6.1.

     

       1014
       1014
       -
             Contains requested identities.

     

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

     

       1016
       1016
       -
         *)

     

       1017
       1017
       -
         type identity_get_response = {

     

       1018
       1018
       -
           account_id : id;  (** The account from which identities were fetched *)

     

       1019
       1019
       -
           state : string;  (** A string representing the state on the server *)

     

       1020
       1020
       -
           list : identity list;  (** The list of identities requested *)

     

       1021
       1021
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       1022
       1022
       -
         }

     

       1023
       1023
       -
       

     

       1024
       1024
       -
         (** Identity/changes request arguments as defined in RFC8621 Section 6.2.

     

       1025
       1025
       -
             Used to get identity changes since a previous state.

     

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

     

       1027
       1027
       -
         *)

     

       1028
       1028
       -
         type identity_changes_arguments = {

     

       1029
       1029
       -
           account_id : id;  (** The account to get changes for *)

     

       1030
       1030
       -
           since_state : string;  (** The previous state to compare to *)

     

       1031
       1031
       -
           max_changes : unsigned_int option;  (** Maximum number of changes to return *)

     

       1032
       1032
       -
         }

     

       1033
       1033
       -
       

     

       1034
       1034
       -
         (** Identity/changes response as defined in RFC8621 Section 6.2.

     

       1035
       1035
       -
             Reports identities that have changed since a previous state.

     

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

     

       1037
       1037
       -
         *)

     

       1038
       1038
       -
         type identity_changes_response = {

     

       1039
       1039
       -
           account_id : id;  (** The account changes are for *)

     

       1040
       1040
       -
           old_state : string;  (** The state provided in the request *)

     

       1041
       1041
       -
           new_state : string;  (** The current state on the server *)

     

       1042
       1042
       -
           has_more_changes : bool;  (** If true, more changes are available *)

     

       1043
       1043
       -
           created : id list;  (** IDs of identities created since old_state *)

     

       1044
       1044
       -
           updated : id list;  (** IDs of identities updated since old_state *)

     

       1045
       1045
       -
           destroyed : id list;  (** IDs of identities destroyed since old_state *)

     

       1046
       1046
       -
         }

     

       1047
       1047
       -
       

     

       1048
       1048
       -
         (** Identity/set request arguments as defined in RFC8621 Section 6.3.

     

       1049
       1049
       -
             Used to create, update, and destroy identities.

     

       1050
       1050
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1051
       1051
       -
         *)

     

       1052
       1052
       -
         type identity_set_arguments = {

     

       1053
       1053
       -
           account_id : id;  (** The account to make changes in *)

     

       1054
       1054
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       1055
       1055
       -
           create : (id * identity_creation) list option;  (** Map of creation IDs to identities to create *)

     

       1056
       1056
       -
           update : (id * identity_update) list option;  (** Map of IDs to update properties *)

     

       1057
       1057
       -
           destroy : id list option;  (** List of IDs to destroy *)

     

       1058
       1058
       -
         }

     

       1059
       1059
       -
       

     

       1060
       1060
       -
         (** Properties for identity creation as defined in RFC8621 Section 6.3.

     

       1061
       1061
       -
             Used to create new identities.

     

       1062
       1062
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1063
       1063
       -
         *)

     

       1064
       1064
       -
         and identity_creation = {

     

       1065
       1065
       -
           name : string;  (** Display name for the identity *)

     

       1066
       1066
       -
           email : string;  (** Email address for the identity *)

     

       1067
       1067
       -
           reply_to : email_address list option;  (** Reply-To addresses to use when sending *)

     

       1068
       1068
       -
           bcc : email_address list option;  (** BCC addresses to automatically include *)

     

       1069
       1069
       -
           text_signature : string option;  (** Plain text signature for the identity *)

     

       1070
       1070
       -
           html_signature : string option;  (** HTML signature for the identity *)

     

       1071
       1071
       -
         }

     

       1072
       1072
       -
       

     

       1073
       1073
       -
         (** Properties for identity update as defined in RFC8621 Section 6.3.

     

       1074
       1074
       -
             Used to update existing identities.

     

       1075
       1075
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1076
       1076
       -
         *)

     

       1077
       1077
       -
         and identity_update = {

     

       1078
       1078
       -
           name : string option;  (** New display name for the identity *)

     

       1079
       1079
       -
           email : string option;  (** New email address for the identity *)

     

       1080
       1080
       -
           reply_to : email_address list option;  (** New Reply-To addresses to use *)

     

       1081
       1081
       -
           bcc : email_address list option;  (** New BCC addresses to automatically include *)

     

       1082
       1082
       -
           text_signature : string option;  (** New plain text signature *)

     

       1083
       1083
       -
           html_signature : string option;  (** New HTML signature *)

     

       1084
       1084
       -
         }

     

       1085
       1085
       -
       

     

       1086
       1086
       -
         (** Identity/set response as defined in RFC8621 Section 6.3.

     

       1087
       1087
       -
             Reports the results of identity changes.

     

       1088
       1088
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>

     

       1089
       1089
       -
         *)

     

       1090
       1090
       -
         type identity_set_response = {

     

       1091
       1091
       -
           account_id : id;  (** The account that was modified *)

     

       1092
       1092
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       1093
       1093
       -
           new_state : string;  (** The current state on the server *)

     

       1094
       1094
       -
           created : (id * identity) list option;  (** Map of creation IDs to created identities *)

     

       1095
       1095
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       1096
       1096
       -
           destroyed : id list option;  (** List of IDs that were successfully destroyed *)

     

       1097
       1097
       -
           not_created : (id * set_error) list option;  (** Map of IDs to errors for failed creates *)

     

       1098
       1098
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       1099
       1099
       -
           not_destroyed : (id * set_error) list option;  (** Map of IDs to errors for failed destroys *)

     

       1100
       1100
       -
         }

     

       1101
       1101
       -
       

     

       1102
       1102
       -
         (** {1:vacation_response VacationResponse objects}

     

       1103
       1103
       -
             Vacation response types as defined in RFC8621 Section 7

     

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

     

       1105
       1105
       -
         *)

     

       1106
       1106
       -
       

     

       1107
       1107
       -
         (** Vacation auto-reply setting as defined in RFC8621 Section 7.

     

       1108
       1108
       -
             Represents an automatic vacation/out-of-office response.

     

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

     

       1110
       1110
       -
         *)

     

       1111
       1111
       -
         type vacation_response = {

     

       1112
       1112
       -
           id : id;  (** Server-assigned ID for the vacation response *)

     

       1113
       1113
       -
           is_enabled : bool;  (** Whether the vacation response is active *)

     

       1114
       1114
       -
           from_date : utc_date option;  (** Start date-time of the vacation period *)

     

       1115
       1115
       -
           to_date : utc_date option;  (** End date-time of the vacation period *)

     

       1116
       1116
       -
           subject : string option;  (** Subject line for the vacation response *)

     

       1117
       1117
       -
           text_body : string option;  (** Plain text body for the vacation response *)

     

       1118
       1118
       -
           html_body : string option;  (** HTML body for the vacation response *)

     

       1119
       1119
       -
         }

     

       1120
       1120
       -
       

     

       1121
       1121
       -
         (** VacationResponse/get request arguments as defined in RFC8621 Section 7.2.

     

       1122
       1122
       -
             Used to fetch vacation responses by ID.

     

       1123
       1123
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>

     

       1124
       1124
       -
         *)

     

       1125
       1125
       -
         type vacation_response_get_arguments = {

     

       1126
       1126
       -
           account_id : id;  (** The account to fetch vacation responses from *)

     

       1127
       1127
       -
           ids : id list option;  (** The IDs of vacation responses to fetch, null means all *)

     

       1128
       1128
       -
           properties : string list option;  (** Properties to return, null means all *)

     

       1129
       1129
       -
         }

     

       1130
       1130
       -
       

     

       1131
       1131
       -
         (** VacationResponse/get response as defined in RFC8621 Section 7.2.

     

       1132
       1132
       -
             Contains requested vacation responses.

     

       1133
       1133
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>

     

       1134
       1134
       -
         *)

     

       1135
       1135
       -
         type vacation_response_get_response = {

     

       1136
       1136
       -
           account_id : id;  (** The account from which vacation responses were fetched *)

     

       1137
       1137
       -
           state : string;  (** A string representing the state on the server *)

     

       1138
       1138
       -
           list : vacation_response list;  (** The list of vacation responses requested *)

     

       1139
       1139
       -
           not_found : id list;  (** IDs requested that could not be found *)

     

       1140
       1140
       -
         }

     

       1141
       1141
       -
       

     

       1142
       1142
       -
         (** VacationResponse/set request arguments as defined in RFC8621 Section 7.3.

     

       1143
       1143
       -
             Used to update vacation responses.

     

       1144
       1144
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1145
       1145
       -
         *)

     

       1146
       1146
       -
         type vacation_response_set_arguments = {

     

       1147
       1147
       -
           account_id : id;  (** The account to make changes in *)

     

       1148
       1148
       -
           if_in_state : string option;  (** Only apply changes if in this state *)

     

       1149
       1149
       -
           update : (id * vacation_response_update) list;  (** Map of IDs to update properties *)

     

       1150
       1150
       -
         }

     

       1151
       1151
       -
       

     

       1152
       1152
       -
         (** Properties for vacation response update as defined in RFC8621 Section 7.3.

     

       1153
       1153
       -
             Used to update existing vacation responses.

     

       1154
       1154
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1155
       1155
       -
         *)

     

       1156
       1156
       -
         and vacation_response_update = {

     

       1157
       1157
       -
           is_enabled : bool option;  (** Whether the vacation response is active *)

     

       1158
       1158
       -
           from_date : utc_date option;  (** Start date-time of the vacation period *)

     

       1159
       1159
       -
           to_date : utc_date option;  (** End date-time of the vacation period *)

     

       1160
       1160
       -
           subject : string option;  (** Subject line for the vacation response *)

     

       1161
       1161
       -
           text_body : string option;  (** Plain text body for the vacation response *)

     

       1162
       1162
       -
           html_body : string option;  (** HTML body for the vacation response *)

     

       1163
       1163
       -
         }

     

       1164
       1164
       -
       

     

       1165
       1165
       -
         (** VacationResponse/set response as defined in RFC8621 Section 7.3.

     

       1166
       1166
       -
             Reports the results of vacation response changes.

     

       1167
       1167
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>

     

       1168
       1168
       -
         *)

     

       1169
       1169
       -
         type vacation_response_set_response = {

     

       1170
       1170
       -
           account_id : id;  (** The account that was modified *)

     

       1171
       1171
       -
           old_state : string option;  (** The state before processing, if changed *)

     

       1172
       1172
       -
           new_state : string;  (** The current state on the server *)

     

       1173
       1173
       -
           updated : id list option;  (** List of IDs that were successfully updated *)

     

       1174
       1174
       -
           not_updated : (id * set_error) list option;  (** Map of IDs to errors for failed updates *)

     

       1175
       1175
       -
         }

     

       1176
       1176
       -
         

     

       1177
       1177
       -
         (** {1:message_flags Message Flags and Mailbox Attributes}

     

       1178
       1178
       -
             Message flag types as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02

     

       1179
       1179
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute>

     

       1180
       1180
       -
         *)

     

       1181
       1181
       -
         

     

       1182
       1182
       -
         (** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords

     

       1183
       1183
       -
             as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 3.

     

       1184
       1184
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3>

     

       1185
       1185
       -
         *)

     

       1186
       1186
       -
         type flag_color =

     

       1187
       1187
       -
           | Red     (** Bit pattern 000 - default color *)

     

       1188
       1188
       -
           | Orange  (** Bit pattern 100 - MailFlagBit2 set *)

     

       1189
       1189
       -
           | Yellow  (** Bit pattern 010 - MailFlagBit1 set *)

     

       1190
       1190
       -
           | Green   (** Bit pattern 111 - all bits set *)

     

       1191
       1191
       -
           | Blue    (** Bit pattern 001 - MailFlagBit0 set *)

     

       1192
       1192
       -
           | Purple  (** Bit pattern 101 - MailFlagBit2 and MailFlagBit0 set *)

     

       1193
       1193
       -
           | Gray    (** Bit pattern 011 - MailFlagBit1 and MailFlagBit0 set *)

     

       1194
       1194
       -
         

     

       1195
       1195
       -
         (** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.1.

     

       1196
       1196
       -
             These are standardized keywords that can be applied to email messages.

     

       1197
       1197
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.1>

     

       1198
       1198
       -
         *)

     

       1199
       1199
       -
         type message_keyword =

     

       1200
       1200
       -
           | Notify         (** Indicate a notification should be shown for this message *)

     

       1201
       1201
       -
           | Muted          (** User is not interested in future replies to this thread *)

     

       1202
       1202
       -
           | Followed       (** User is particularly interested in future replies to this thread *)

     

       1203
       1203
       -
           | Memo           (** Message is a note-to-self about another message in the same thread *)

     

       1204
       1204
       -
           | HasMemo        (** Message has an associated memo with the $memo keyword *)

     

       1205
       1205
       -
           | HasAttachment  (** Message has an attachment *)

     

       1206
       1206
       -
           | HasNoAttachment (** Message does not have an attachment *)

     

       1207
       1207
       -
           | AutoSent       (** Message was sent automatically as a response due to a user rule *)

     

       1208
       1208
       -
           | Unsubscribed   (** User has unsubscribed from the thread this message is in *)

     

       1209
       1209
       -
           | CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)

     

       1210
       1210
       -
           | Imported       (** Message was imported from another mailbox *)

     

       1211
       1211
       -
           | IsTrusted      (** Server has verified authenticity of the from name and email *)

     

       1212
       1212
       -
           | MaskedEmail    (** Message was received via an alias created for an individual sender *)

     

       1213
       1213
       -
           | New            (** Message should be made more prominent due to a recent action *)

     

       1214
       1214
       -
           | MailFlagBit0   (** Bit 0 of the 3-bit flag color pattern *)

     

       1215
       1215
       -
           | MailFlagBit1   (** Bit 1 of the 3-bit flag color pattern *)

     

       1216
       1216
       -
           | MailFlagBit2   (** Bit 2 of the 3-bit flag color pattern *)

     

       1217
       1217
       -
           | OtherKeyword of string (** Other non-standard keywords *)

     

       1218
       1218
       -
         

     

       1219
       1219
       -
         (** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.2.

     

       1220
       1220
       -
             These are standardized attributes for special-purpose mailboxes.

     

       1221
       1221
       -
             @see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.2>

     

       1222
       1222
       -
         *)

     

       1223
       1223
       -
         type mailbox_attribute =

     

       1224
       1224
       -
           | Snoozed    (** Mailbox containing messages that have been snoozed *)

     

       1225
       1225
       -
           | Scheduled  (** Mailbox containing messages scheduled to be sent later *)

     

       1226
       1226
       -
           | Memos      (** Mailbox containing messages with the $memo keyword *)

     

       1227
       1227
       -
           | OtherAttribute of string (** Other non-standard mailbox attributes *)

     

       1228
       1228
       -
         

     

       1229
       1229
       -
         (** Convert bit values to a flag color

     

       1230
       1230
       -
             @param bit0 Value of bit 0 (least significant bit)

     

       1231
       1231
       -
             @param bit1 Value of bit 1

     

       1232
       1232
       -
             @param bit2 Value of bit 2 (most significant bit)

     

       1233
       1233
       -
             @return The corresponding flag color

     

       1234
       1234
       -
         *)

     

       1235
       1235
       -
         val flag_color_of_bits : bool -> bool -> bool -> flag_color

     

       1236
       1236
       -
         

     

       1237
       1237
       -
         (** Get the bit values for a flag color

     

       1238
       1238
       -
             @param color The flag color

     

       1239
       1239
       -
             @return Tuple of (bit2, bit1, bit0) values

     

       1240
       1240
       -
         *)

     

       1241
       1241
       -
         val bits_of_flag_color : flag_color -> bool * bool * bool

     

       1242
       1242
       -
         

     

       1243
       1243
       -
         (** Check if a message has a flag color based on its keywords

     

       1244
       1244
       -
             @param keywords The list of keywords for the message

     

       1245
       1245
       -
             @return True if the message has one or more flag color bits set

     

       1246
       1246
       -
         *)

     

       1247
       1247
       -
         val has_flag_color : (keyword * bool) list -> bool

     

       1248
       1248
       -
         

     

       1249
       1249
       -
         (** Get the flag color from a message's keywords, if present

     

       1250
       1250
       -
             @param keywords The list of keywords for the message

     

       1251
       1251
       -
             @return The flag color if all required bits are present, None otherwise

     

       1252
       1252
       -
         *)

     

       1253
       1253
       -
         val get_flag_color : (keyword * bool) list -> flag_color option

     

       1254
       1254
       -
         

     

       1255
       1255
       -
         (** Convert a message keyword to its string representation

     

       1256
       1256
       -
             @param keyword The message keyword

     

       1257
       1257
       -
             @return String representation with $ prefix (e.g., "$notify")

     

       1258
       1258
       -
         *)

     

       1259
       1259
       -
         val string_of_message_keyword : message_keyword -> string

     

       1260
       1260
       -
         

     

       1261
       1261
       -
         (** Parse a string into a message keyword

     

       1262
       1262
       -
             @param s The string to parse (with or without $ prefix)

     

       1263
       1263
       -
             @return The corresponding message keyword

     

       1264
       1264
       -
         *)

     

       1265
       1265
       -
         val message_keyword_of_string : string -> message_keyword

     

       1266
       1266
       -
         

     

       1267
       1267
       -
         (** Convert a mailbox attribute to its string representation

     

       1268
       1268
       -
             @param attr The mailbox attribute

     

       1269
       1269
       -
             @return String representation with $ prefix (e.g., "$snoozed")

     

       1270
       1270
       -
         *)

     

       1271
       1271
       -
         val string_of_mailbox_attribute : mailbox_attribute -> string

     

       1272
       1272
       -
         

     

       1273
       1273
       -
         (** Parse a string into a mailbox attribute

     

       1274
       1274
       -
             @param s The string to parse (with or without $ prefix)

     

       1275
       1275
       -
             @return The corresponding mailbox attribute

     

       1276
       1276
       -
         *)

     

       1277
       1277
       -
         val mailbox_attribute_of_string : string -> mailbox_attribute

     

       1278
       1278
       -
         

     

       1279
       1279
       -
         (** Get a human-readable representation of a flag color

     

       1280
       1280
       -
             @param color The flag color

     

       1281
       1281
       -
             @return Human-readable name of the color

     

       1282
       1282
       -
         *)

     

       1283
       1283
       -
         val human_readable_flag_color : flag_color -> string

     

       1284
       1284
       -
         

     

       1285
       1285
       -
         (** Get a human-readable representation of a message keyword

     

       1286
       1286
       -
             @param keyword The message keyword

     

       1287
       1287
       -
             @return Human-readable description of the keyword

     

       1288
       1288
       -
         *)

     

       1289
       1289
       -
         val human_readable_message_keyword : message_keyword -> string

     

       1290
       1290
       -
         

     

       1291
       1291
       -
         (** Format email keywords into a human-readable string representation

     

       1292
       1292
       -
             @param keywords The list of keywords and their values

     

       1293
       1293
       -
             @return Human-readable comma-separated list of keywords

     

       1294
       1294
       -
         *)

     

       1295
       1295
       -
         val format_email_keywords : (keyword * bool) list -> string

     

       1296
       1296
       -
       end

     

       1297
       1297
       -
       

     

       1298
       1298
       -
       (** {1 JSON serialization}

     

       1299
       1299
       -
           Functions for serializing and deserializing JMAP Mail objects to/from JSON

     

       1300
       1300
       -
       *)

     

       1301
       1301
       -
       

     

       1302
       1302
       -
       module Json : sig

     

       1303
       1303
       -
         open Types

     

       1304
       1304
       -
       

     

       1305
       1305
       -
         (** {2 Helper functions for serialization}

     

       1306
       1306
       -
             Utility functions for converting between OCaml types and JSON representation

     

       1307
       1307
       -
         *)

     

       1308
       1308
       -
         

     

       1309
       1309
       -
         (** Convert a mailbox role to its string representation

     

       1310
       1310
       -
             @param role The mailbox role

     

       1311
       1311
       -
             @return String representation (e.g., "inbox", "drafts", etc.)

     

       1312
       1312
       -
         *)

     

       1313
       1313
       -
         val string_of_mailbox_role : mailbox_role -> string

     

       1314
       1314
       -
         

     

       1315
       1315
       -
         (** Parse a string into a mailbox role

     

       1316
       1316
       -
             @param s The string to parse

     

       1317
       1317
       -
             @return The corresponding mailbox role, or Unknown if not recognized

     

       1318
       1318
       -
         *)

     

       1319
       1319
       -
         val mailbox_role_of_string : string -> mailbox_role

     

       1320
       1320
       -
         

     

       1321
       1321
       -
         (** Convert an email keyword to its string representation

     

       1322
       1322
       -
             @param keyword The email keyword

     

       1323
       1323
       -
             @return String representation with $ prefix (e.g., "$flagged")

     

       1324
       1324
       -
         *)

     

       1325
       1325
       -
         val string_of_keyword : keyword -> string

     

       1326
       1326
       -
         

     

       1327
       1327
       -
         (** Parse a string into an email keyword

     

       1328
       1328
       -
             @param s The string to parse (with or without $ prefix)

     

       1329
       1329
       -
             @return The corresponding email keyword

     

       1330
       1330
       -
         *)

     

       1331
       1331
       -
         val keyword_of_string : string -> keyword

     

       1332
       1332
       -
       

     

       1333
       1333
       -
         (** {2 Mailbox serialization}

     

       1334
       1334
       -
             Functions for serializing and deserializing mailbox objects

     

       1335
       1335
       -
         *)

     

       1336
       1336
       -
       

     

       1337
       1337
       -
         (** TODO:claude - Need to implement all JSON serialization functions 

     

       1338
       1338
       -
             for each type we've defined. This would be a substantial amount of

     

       1339
       1339
       -
             code and likely require additional understanding of the ezjsonm API.

     

       1340
       1340
       -
             

     

       1341
       1341
       -
             The interface would include functions like:

     

       1342
       1342
       -
             

     

       1343
       1343
       -
             val mailbox_to_json : mailbox -> Ezjsonm.value

     

       1344
       1344
       -
             val mailbox_of_json : Ezjsonm.value -> mailbox result

     

       1345
       1345
       -
             

     

       1346
       1346
       -
             And similarly for all other types.

     

       1347
       1347
       -
         *)

     

       1348
       1348
       -
       end

     

       1349
       1349
       -
       

     

       1350
       1350
       -
       (** {1 API functions}

     

       1351
       1351
       -
           High-level functions for interacting with JMAP Mail servers

     

       1352
       1352
       -
       *)

     

       1353
       1353
       -
       

     

       1354
       1354
       -
       (** Authentication credentials for a JMAP server *)

     

       1355
       1355
       -
       type credentials = {

     

       1356
       1356
       -
         username: string;  (** Username for authentication *)

     

       1357
       1357
       -
         password: string;  (** Password for authentication *)

     

       1358
       1358
       -
       }

     

       1359
       1359
       -
       

     

       1360
       1360
       -
       (** Connection to a JMAP mail server *)

     

       1361
       1361
       -
       type connection = {

     

       1362
       1362
       -
         session: Jmap.Types.session;  (** Session information from the server *)

     

       1363
       1363
       -
         config: Jmap.Api.config;      (** Configuration for API requests *)

     

       1364
       1364
       -
       }

     

       1365
       1365
       -
       

     

       1366
       1366
       -
       (** Login to a JMAP server and establish a connection

     

       1367
       1367
       -
           @param uri The URI of the JMAP server

     

       1368
       1368
       -
           @param credentials Authentication credentials

     

       1369
       1369
       -
           @return A connection object if successful

     

       1370
       1370
       -
           

     

       1371
       1371
       -
           Creates a new connection to a JMAP server using username/password authentication.

     

       1372
       1372
       -
       *)

     

       1373
       1373
       -
       val login : 

     

       1374
       1374
       -
         uri:string -> 

     

       1375
       1375
       -
         credentials:credentials -> 

     

       1376
       1376
       -
         (connection, Jmap.Api.error) result Lwt.t

     

       1377
       1377
       -
       

     

       1378
       1378
       -
       (** Login to a JMAP server using an API token

     

       1379
       1379
       -
           @param uri The URI of the JMAP server

     

       1380
       1380
       -
           @param api_token The API token for authentication

     

       1381
       1381
       -
           @return A connection object if successful

     

       1382
       1382
       -
           

     

       1383
       1383
       -
           Creates a new connection to a JMAP server using Bearer token authentication.

     

       1384
       1384
       -
       *)

     

       1385
       1385
       -
       val login_with_token : 

     

       1386
       1386
       -
         uri:string -> 

     

       1387
       1387
       -
         api_token:string -> 

     

       1388
       1388
       -
         (connection, Jmap.Api.error) result Lwt.t

     

       1389
       1389
       -
       

     

       1390
       1390
       -
       (** Get all mailboxes for an account

     

       1391
       1391
       -
           @param conn The JMAP connection

     

       1392
       1392
       -
           @param account_id The account ID to get mailboxes for

     

       1393
       1393
       -
           @return A list of mailboxes if successful

     

       1394
       1394
       -
           

     

       1395
       1395
       -
           Retrieves all mailboxes (folders) in the specified account.

     

       1396
       1396
       -
       *)

     

       1397
       1397
       -
       val get_mailboxes : 

     

       1398
       1398
       -
         connection -> 

     

       1399
       1399
       -
         account_id:Jmap.Types.id -> 

     

       1400
       1400
       -
         (Types.mailbox list, Jmap.Api.error) result Lwt.t

     

       1401
       1401
       -
       

     

       1402
       1402
       -
       (** Get a specific mailbox by ID

     

       1403
       1403
       -
           @param conn The JMAP connection

     

       1404
       1404
       -
           @param account_id The account ID

     

       1405
       1405
       -
           @param mailbox_id The mailbox ID to retrieve

     

       1406
       1406
       -
           @return The mailbox if found

     

       1407
       1407
       -
           

     

       1408
       1408
       -
           Retrieves a single mailbox by its ID.

     

       1409
       1409
       -
       *)

     

       1410
       1410
       -
       val get_mailbox : 

     

       1411
       1411
       -
         connection -> 

     

       1412
       1412
       -
         account_id:Jmap.Types.id -> 

     

       1413
       1413
       -
         mailbox_id:Jmap.Types.id -> 

     

       1414
       1414
       -
         (Types.mailbox, Jmap.Api.error) result Lwt.t

     

       1415
       1415
       -
       

     

       1416
       1416
       -
       (** Get messages in a mailbox

     

       1417
       1417
       -
           @param conn The JMAP connection

     

       1418
       1418
       -
           @param account_id The account ID

     

       1419
       1419
       -
           @param mailbox_id The mailbox ID to get messages from

     

       1420
       1420
       -
           @param limit Optional limit on number of messages to return

     

       1421
       1421
       -
           @return The list of email messages if successful

     

       1422
       1422
       -
           

     

       1423
       1423
       -
           Retrieves email messages in the specified mailbox, with optional limit.

     

       1424
       1424
       -
       *)

     

       1425
       1425
       -
       val get_messages_in_mailbox : 

     

       1426
       1426
       -
         connection -> 

     

       1427
       1427
       -
         account_id:Jmap.Types.id -> 

     

       1428
       1428
       -
         mailbox_id:Jmap.Types.id -> 

     

       1429
       1429
       -
         ?limit:int -> 

     

       1430
       1430
       -
         unit -> 

     

       1431
       1431
       -
         (Types.email list, Jmap.Api.error) result Lwt.t

     

       1432
       1432
       -
       

     

       1433
       1433
       -
       (** Get a single email message by ID

     

       1434
       1434
       -
           @param conn The JMAP connection

     

       1435
       1435
       -
           @param account_id The account ID

     

       1436
       1436
       -
           @param email_id The email ID to retrieve

     

       1437
       1437
       -
           @return The email message if found

     

       1438
       1438
       -
           

     

       1439
       1439
       -
           Retrieves a single email message by its ID.

     

       1440
       1440
       -
       *)

     

       1441
       1441
       -
       val get_email : 

     

       1442
       1442
       -
         connection -> 

     

       1443
       1443
       -
         account_id:Jmap.Types.id -> 

     

       1444
       1444
       -
         email_id:Jmap.Types.id -> 

     

       1445
       1445
       -
         (Types.email, Jmap.Api.error) result Lwt.t

     

       1446
       1446
       -
         

     

       1447
       1447
       -
       (** Check if an email has a specific message keyword

     

       1448
       1448
       -
           @param email The email to check

     

       1449
       1449
       -
           @param keyword The message keyword to look for

     

       1450
       1450
       -
           @return true if the email has the keyword, false otherwise

     

       1451
       1451
       -
           

     

       1452
       1452
       -
           Tests whether an email has a particular keyword (flag) set.

     

       1453
       1453
       -
       *)

     

       1454
       1454
       -
       val has_message_keyword :

     

       1455
       1455
       -
         Types.email ->

     

       1456
       1456
       -
         Types.message_keyword ->

     

       1457
       1457
       -
         bool

     

       1458
       1458
       -
       

     

       1459
       1459
       -
       (** Add a message keyword to an email

     

       1460
       1460
       -
           @param conn The JMAP connection

     

       1461
       1461
       -
           @param account_id The account ID

     

       1462
       1462
       -
           @param email_id The email ID

     

       1463
       1463
       -
           @param keyword The message keyword to add

     

       1464
       1464
       -
           @return Success or error

     

       1465
       1465
       -
           

     

       1466
       1466
       -
           Adds a keyword (flag) to an email message.

     

       1467
       1467
       -
       *)

     

       1468
       1468
       -
       val add_message_keyword :

     

       1469
       1469
       -
         connection ->

     

       1470
       1470
       -
         account_id:Jmap.Types.id ->

     

       1471
       1471
       -
         email_id:Jmap.Types.id ->

     

       1472
       1472
       -
         keyword:Types.message_keyword ->

     

       1473
       1473
       -
         (unit, Jmap.Api.error) result Lwt.t

     

       1474
       1474
       -
       

     

       1475
       1475
       -
       (** Set a flag color for an email

     

       1476
       1476
       -
           @param conn The JMAP connection

     

       1477
       1477
       -
           @param account_id The account ID

     

       1478
       1478
       -
           @param email_id The email ID

     

       1479
       1479
       -
           @param color The flag color to set

     

       1480
       1480
       -
           @return Success or error

     

       1481
       1481
       -
           

     

       1482
       1482
       -
           Sets a flag color on an email message by setting the appropriate bit flags.

     

       1483
       1483
       -
       *)

     

       1484
       1484
       -
       val set_flag_color :

     

       1485
       1485
       -
         connection ->

     

       1486
       1486
       -
         account_id:Jmap.Types.id ->

     

       1487
       1487
       -
         email_id:Jmap.Types.id ->

     

       1488
       1488
       -
         color:Types.flag_color ->

     

       1489
       1489
       -
         (unit, Jmap.Api.error) result Lwt.t

     

       1490
       1490
       -
       

     

       1491
       1491
       -
       (** Convert an email's keywords to typed message_keyword list

     

       1492
       1492
       -
           @param email The email to analyze

     

       1493
       1493
       -
           @return List of message keywords

     

       1494
       1494
       -
           

     

       1495
       1495
       -
           Extracts all message keywords from an email's keyword list.

     

       1496
       1496
       -
       *)

     

       1497
       1497
       -
       val get_message_keywords :

     

       1498
       1498
       -
         Types.email ->

     

       1499
       1499
       -
         Types.message_keyword list

     

       1500
       1500
       -
       

     

       1501
       1501
       -
       (** Get emails with a specific message keyword

     

       1502
       1502
       -
           @param conn The JMAP connection

     

       1503
       1503
       -
           @param account_id The account ID

     

       1504
       1504
       -
           @param keyword The message keyword to search for

     

       1505
       1505
       -
           @param limit Optional limit on number of emails to return

     

       1506
       1506
       -
           @return List of emails with the keyword if successful

     

       1507
       1507
       -
           

     

       1508
       1508
       -
           Retrieves all emails that have a specific keyword (flag) set.

     

       1509
       1509
       -
       *)

     

       1510
       1510
       -
       val get_emails_with_keyword :

     

       1511
       1511
       -
         connection ->

     

       1512
       1512
       -
         account_id:Jmap.Types.id ->

     

       1513
       1513
       -
         keyword:Types.message_keyword ->

     

       1514
       1514
       -
         ?limit:int ->

     

       1515
       1515
       -
         unit ->

     

       1516
       1516
       -
         (Types.email list, Jmap.Api.error) result Lwt.t

     

       1517
       1517
       -
       

     

       1518
       1518
       -
       (** {1 Email Submission}

     

       1519
       1519
       -
           Functions for sending emails

     

       1520
       1520
       -
       *)

     

       1521
       1521
       -
       

     

       1522
       1522
       -
       (** Create a new email draft

     

       1523
       1523
       -
           @param conn The JMAP connection

     

       1524
       1524
       -
           @param account_id The account ID

     

       1525
       1525
       -
           @param mailbox_id The mailbox ID to store the draft in (usually "drafts")

     

       1526
       1526
       -
           @param from The sender's email address 

     

       1527
       1527
       -
           @param to_addresses List of recipient email addresses

     

       1528
       1528
       -
           @param subject The email subject line

     

       1529
       1529
       -
           @param text_body Plain text message body

     

       1530
       1530
       -
           @param html_body Optional HTML message body

     

       1531
       1531
       -
           @return The created email ID if successful

     

       1532
       1532
       -
           

     

       1533
       1533
       -
           Creates a new email draft in the specified mailbox with the provided content.

     

       1534
       1534
       -
       *)

     

       1535
       1535
       -
       val create_email_draft :

     

       1536
       1536
       -
         connection ->

     

       1537
       1537
       -
         account_id:Jmap.Types.id ->

     

       1538
       1538
       -
         mailbox_id:Jmap.Types.id ->

     

       1539
       1539
       -
         from:string ->

     

       1540
       1540
       -
         to_addresses:string list ->

     

       1541
       1541
       -
         subject:string ->

     

       1542
       1542
       -
         text_body:string ->

     

       1543
       1543
       -
         ?html_body:string ->

     

       1544
       1544
       -
         unit ->

     

       1545
       1545
       -
         (Jmap.Types.id, Jmap.Api.error) result Lwt.t

     

       1546
       1546
       -
       

     

       1547
       1547
       -
       (** Get all identities for an account

     

       1548
       1548
       -
           @param conn The JMAP connection

     

       1549
       1549
       -
           @param account_id The account ID

     

       1550
       1550
       -
           @return A list of identities if successful

     

       1551
       1551
       -
           

     

       1552
       1552
       -
           Retrieves all identities (email addresses that can be used for sending) for an account.

     

       1553
       1553
       -
       *)

     

       1554
       1554
       -
       val get_identities :

     

       1555
       1555
       -
         connection ->

     

       1556
       1556
       -
         account_id:Jmap.Types.id ->

     

       1557
       1557
       -
         (Types.identity list, Jmap.Api.error) result Lwt.t

     

       1558
       1558
       -
       

     

       1559
       1559
       -
       (** Find a suitable identity by email address

     

       1560
       1560
       -
           @param conn The JMAP connection

     

       1561
       1561
       -
           @param account_id The account ID

     

       1562
       1562
       -
           @param email The email address to match

     

       1563
       1563
       -
           @return The identity if found, otherwise Error

     

       1564
       1564
       -
           

     

       1565
       1565
       -
           Finds an identity that matches the given email address, either exactly or

     

       1566
       1566
       -
           via a wildcard pattern (e.g., *@domain.com).

     

       1567
       1567
       -
       *)

     

       1568
       1568
       -
       val find_identity_by_email :

     

       1569
       1569
       -
         connection ->

     

       1570
       1570
       -
         account_id:Jmap.Types.id ->

     

       1571
       1571
       -
         email:string ->

     

       1572
       1572
       -
         (Types.identity, Jmap.Api.error) result Lwt.t

     

       1573
       1573
       -
       

     

       1574
       1574
       -
       (** Submit an email for delivery

     

       1575
       1575
       -
           @param conn The JMAP connection

     

       1576
       1576
       -
           @param account_id The account ID

     

       1577
       1577
       -
           @param identity_id The identity ID to send from

     

       1578
       1578
       -
           @param email_id The email ID to submit

     

       1579
       1579
       -
           @param envelope Optional custom envelope

     

       1580
       1580
       -
           @return The submission ID if successful

     

       1581
       1581
       -
           

     

       1582
       1582
       -
           Submits an existing email (usually a draft) for delivery using the specified identity.

     

       1583
       1583
       -
       *)

     

       1584
       1584
       -
       val submit_email :

     

       1585
       1585
       -
         connection ->

     

       1586
       1586
       -
         account_id:Jmap.Types.id ->

     

       1587
       1587
       -
         identity_id:Jmap.Types.id ->

     

       1588
       1588
       -
         email_id:Jmap.Types.id ->

     

       1589
       1589
       -
         ?envelope:Types.envelope ->

     

       1590
       1590
       -
         unit ->

     

       1591
       1591
       -
         (Jmap.Types.id, Jmap.Api.error) result Lwt.t

     

       1592
       1592
       -
       

     

       1593
       1593
       -
       (** Create and submit an email in one operation

     

       1594
       1594
       -
           @param conn The JMAP connection

     

       1595
       1595
       -
           @param account_id The account ID

     

       1596
       1596
       -
           @param from The sender's email address 

     

       1597
       1597
       -
           @param to_addresses List of recipient email addresses

     

       1598
       1598
       -
           @param subject The email subject line

     

       1599
       1599
       -
           @param text_body Plain text message body

     

       1600
       1600
       -
           @param html_body Optional HTML message body

     

       1601
       1601
       -
           @return The submission ID if successful

     

       1602
       1602
       -
           

     

       1603
       1603
       -
           Creates a new email and immediately submits it for delivery.

     

       1604
       1604
       -
           This is a convenience function that combines create_email_draft and submit_email.

     

       1605
       1605
       -
       *)

     

       1606
       1606
       -
       val create_and_submit_email :

     

       1607
       1607
       -
         connection ->

     

       1608
       1608
       -
         account_id:Jmap.Types.id ->

     

       1609
       1609
       -
         from:string ->

     

       1610
       1610
       -
         to_addresses:string list ->

     

       1611
       1611
       -
         subject:string ->

     

       1612
       1612
       -
         text_body:string ->

     

       1613
       1613
       -
         ?html_body:string ->

     

       1614
       1614
       -
         unit ->

     

       1615
       1615
       -
         (Jmap.Types.id, Jmap.Api.error) result Lwt.t

     

       1616
       1616
       -
       

     

       1617
       1617
       -
       (** Get status of an email submission

     

       1618
       1618
       -
           @param conn The JMAP connection

     

       1619
       1619
       -
           @param account_id The account ID

     

       1620
       1620
       -
           @param submission_id The email submission ID

     

       1621
       1621
       -
           @return The submission status if successful

     

       1622
       1622
       -
           

     

       1623
       1623
       -
           Retrieves the current status of an email submission, including delivery status if available.

     

       1624
       1624
       -
       *)

     

       1625
       1625
       -
       val get_submission_status :

     

       1626
       1626
       -
         connection ->

     

       1627
       1627
       -
         account_id:Jmap.Types.id ->

     

       1628
       1628
       -
         submission_id:Jmap.Types.id ->

     

       1629
       1629
       -
         (Types.email_submission, Jmap.Api.error) result Lwt.t

     

       1630
       1630
       -
         

     

       1631
       1631
       -
       (** {1 Email Address Utilities}

     

       1632
       1632
       -
           Utilities for working with email addresses

     

       1633
       1633
       -
       *)

     

       1634
       1634
       -
       

     

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

     

       1636
       1636
       -
           @param email The email address to check

     

       1637
       1637
       -
           @param pattern The filter pattern to match against

     

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

     

       1639
       1639
       -
           

     

       1640
       1640
       -
           The filter supports simple wildcards:

     

       1641
       1641
       -
           - "*" matches any sequence of characters

     

       1642
       1642
       -
           - "?" matches any single character

     

       1643
       1643
       -
           - Case-insensitive matching is used

     

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

     

       1645
       1645
       -
       *)

     

       1646
       1646
       -
       val email_address_matches : string -> string -> bool

     

       1647
       1647
       -
       

     

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

     

       1649
       1649
       -
           @param email The email object to check

     

       1650
       1650
       -
           @param pattern The sender filter pattern

     

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

     

       1652
       1652
       -
           

     

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

     

       1654
       1654
       -
       *)

     

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

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

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

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

test/proto/date/edge/microseconds.json

···

       1
       1
       +
       2024-01-15T10:30:00.123456Z

test/proto/date/edge/negative_offset.json

···

       1
       1
       +
       2024-01-15T10:30:00-08:00

test/proto/date/invalid/bad_format.json

···

       1
       1
       +
       January 15, 2024

test/proto/date/invalid/invalid_date.json

···

       1
       1
       +
       2024-02-30T10:30:00Z

test/proto/date/invalid/lowercase_t.json

···

       1
       1
       +
       2024-01-15t10:30:00Z

test/proto/date/invalid/lowercase_z.json

···

       1
       1
       +
       2024-01-15T10:30:00z

test/proto/date/invalid/missing_seconds.json

···

       1
       1
       +
       2024-01-15T10:30Z

test/proto/date/invalid/no_timezone.json

···

       1
       1
       +
       2024-01-15T10:30:00

test/proto/date/invalid/not_string.json

test/proto/date/valid/negative_offset.json

···

       1
       1
       +
       2024-01-15T10:30:00-08:00

test/proto/date/valid/utc_z.json

···

       1
       1
       +
       2024-01-15T10:30:00Z

test/proto/date/valid/with_milliseconds.json

···

       1
       1
       +
       2024-01-15T10:30:00.123Z

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

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

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

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

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

test/proto/error/valid/method_error_invalid_arguments.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "type": "invalidArguments",

     

       3
       3
       +
         "description": "Missing required argument: accountId"

     

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

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

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

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

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

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

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

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

test/proto/error/valid/set_error_over_quota.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "type": "overQuota",

     

       3
       3
       +
         "description": "Account storage quota exceeded"

     

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

test/proto/filter/edge/empty_conditions.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "operator": "AND",

     

       3
       3
       +
         "conditions": []

     

       4
       4
       +
       }

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

test/proto/filter/valid/comparator_descending.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "property": "receivedAt",

     

       3
       3
       +
         "isAscending": false

     

       4
       4
       +
       }

test/proto/filter/valid/comparator_minimal.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "property": "size"

     

       3
       3
       +
       }

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

test/proto/filter/valid/not_operator.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "operator": "NOT",

     

       3
       3
       +
         "conditions": [

     

       4
       4
       +
           {"hasKeyword": "$draft"}

     

       5
       5
       +
         ]

     

       6
       6
       +
       }

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

test/proto/filter/valid/simple_condition.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "inMailbox": "inbox123"

     

       3
       3
       +
       }

test/proto/id/edge/creation_ref.json

···

       1
       1
       +
       #newEmail1

test/proto/id/edge/digits_only.json

test/proto/id/edge/max_length_255.json

···

       1
       1
       +
       aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa

test/proto/id/edge/nil_literal.json

test/proto/id/edge/over_max_length_256.json

···

       1
       1
       +
       aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa

test/proto/id/edge/starts_with_dash.json

test/proto/id/edge/starts_with_digit.json

test/proto/id/invalid/empty.json

This is a binary file and will not be displayed.

test/proto/id/invalid/not_string.json

test/proto/id/invalid/null.json

test/proto/id/invalid/with_slash.json

···

       1
       1
       +
       abc/def

test/proto/id/invalid/with_space.json

···

       1
       1
       +
       hello world

test/proto/id/invalid/with_special.json

···

       1
       1
       +
       abc@def

test/proto/id/valid/alphanumeric.json

···

       1
       1
       +
       ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789

test/proto/id/valid/base64_like.json

···

       1
       1
       +
       dXNlcl8xMjM0NTY3ODkw

test/proto/id/valid/simple.json

test/proto/id/valid/single_char.json

test/proto/id/valid/uuid_style.json

···

       1
       1
       +
       550e8400-e29b-41d4-a716-446655440000

test/proto/id/valid/with_hyphen.json

···

       1
       1
       +
       msg-2024-01-15-abcdef

test/proto/id/valid/with_underscore.json

···

       1
       1
       +
       user_123_abc

test/proto/int53/edge/over_max_safe.json

···

       1
       1
       +
       9007199254740992

test/proto/int53/edge/under_min_safe.json

···

       1
       1
       +
       -9007199254740992

test/proto/int53/invalid/float.json

test/proto/int53/invalid/leading_zero.json

test/proto/int53/invalid/null.json

test/proto/int53/invalid/scientific.json

test/proto/int53/invalid/string.json

test/proto/int53/valid/max_safe.json

···

       1
       1
       +
       9007199254740991

test/proto/int53/valid/min_safe.json

···

       1
       1
       +
       -9007199254740991

test/proto/int53/valid/negative.json

test/proto/int53/valid/positive.json

test/proto/int53/valid/zero.json

test/proto/invocation/invalid/not_array.json

···

       1
       1
       +
       {"method": "Email/get", "args": {}, "callId": "c1"}

test/proto/invocation/invalid/wrong_length.json

···

       1
       1
       +
       ["Email/get", {"accountId": "acc1"}]

test/proto/invocation/valid/get.json

···

       1
       1
       +
       ["Email/get", {"accountId": "acc1", "ids": ["e1", "e2"]}, "call-001"]

test/proto/invocation/valid/query.json

···

       1
       1
       +
       ["Email/query", {"accountId": "acc1", "filter": {"inMailbox": "inbox"}, "sort": [{"property": "receivedAt", "isAscending": false}], "limit": 50}, "call-003"]

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

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

test/proto/mail/email_address/valid/email_only.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "email": "anonymous@example.com"

     

       3
       3
       +
       }

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

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

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

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

test/proto/mail/thread/valid/conversation.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "id": "t2",

     

       3
       3
       +
         "emailIds": ["e10", "e11", "e12", "e13", "e14"]

     

       4
       4
       +
       }

test/proto/mail/thread/valid/simple.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "id": "t1",

     

       3
       3
       +
         "emailIds": ["e1"]

     

       4
       4
       +
       }

test/proto/mail/vacation/valid/disabled.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "id": "singleton",

     

       3
       3
       +
         "isEnabled": false

     

       4
       4
       +
       }

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

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

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

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

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

test/proto/request/invalid/missing_using.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "methodCalls": [

     

       3
       3
       +
           ["Mailbox/get", {"accountId": "acc1"}, "c1"]

     

       4
       4
       +
         ]

     

       5
       5
       +
       }

test/proto/request/invalid/not_object.json

···

       1
       1
       +
       ["urn:ietf:params:jmap:core"]

test/proto/request/valid/empty_methods.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "using": ["urn:ietf:params:jmap:core"],

     

       3
       3
       +
         "methodCalls": []

     

       4
       4
       +
       }

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

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

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

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

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

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

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

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

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