commit 8432db22a2621f532a97b3388268c0088fcebe09 · anil.recoil.org/ocaml-jmap

+35

jmap-email.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       name: "jmap-email"

     

       3
       3
       +
       version: "~dev"

     

       4
       4
       +
       synopsis: "JMAP Email extensions library (RFC 8621)"

     

       5
       5
       +
       description: """

     

       6
       6
       +
       OCaml implementation of the JMAP Mail extensions protocol as defined in RFC 8621.

     

       7
       7
       +
       Provides type definitions and structures for working with email in JMAP.

     

       8
       8
       +
       """

     

       9
       9
       +
       maintainer: ["user@example.com"]

     

       10
       10
       +
       authors: ["Example User"]

     

       11
       11
       +
       license: "MIT"

     

       12
       12
       +
       homepage: "https://github.com/example/jmap"

     

       13
       13
       +
       bug-reports: "https://github.com/example/jmap/issues"

     

       14
       14
       +
       depends: [

     

       15
       15
       +
         "ocaml" {>= "4.08.0"}

     

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

     

       17
       17
       +
         "jmap"

     

       18
       18
       +
         "yojson"

     

       19
       19
       +
         "uri"

     

       20
       20
       +
         "odoc" {with-doc}

     

       21
       21
       +
       ]

     

       22
       22
       +
       build: [

     

       23
       23
       +
         ["dune" "subst"] {dev}

     

       24
       24
       +
         [

     

       25
       25
       +
           "dune"

     

       26
       26
       +
           "build"

     

       27
       27
       +
           "-p"

     

       28
       28
       +
           name

     

       29
       29
       +
           "-j"

     

       30
       30
       +
           jobs

     

       31
       31
       +
           "@install"

     

       32
       32
       +
           "@runtest" {with-test}

     

       33
       33
       +
           "@doc" {with-doc}

     

       34
       34
       +
         ]

     

       35
       35
       +
       ]

+13

jmap-email/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap_email)

     

       3
       3
       +
        (public_name jmap-email)

     

       4
       4
       +
        (libraries jmap yojson uri)

     

       5
       5
       +
        (modules

     

       6
       6
       +
         jmap_email

     

       7
       7
       +
         jmap_email_types

     

       8
       8
       +
         jmap_mailbox

     

       9
       9
       +
         jmap_thread

     

       10
       10
       +
         jmap_search_snippet

     

       11
       11
       +
         jmap_identity

     

       12
       12
       +
         jmap_submission

     

       13
       13
       +
         jmap_vacation))

+300

jmap-email/jmap_email.ml

···

       1
       1
       +
       (* JMAP Mail Extension Library (RFC 8621). *)

     

       2
       2
       +
       

     

       3
       3
       +
       (* Core Types *)

     

       4
       4
       +
       module Types = Jmap_email_types

     

       5
       5
       +
       

     

       6
       6
       +
       (* Mailbox *)

     

       7
       7
       +
       module Mailbox = Jmap_mailbox

     

       8
       8
       +
       

     

       9
       9
       +
       (* Thread *)

     

       10
       10
       +
       module Thread = Jmap_thread

     

       11
       11
       +
       

     

       12
       12
       +
       (* Search Snippet *)

     

       13
       13
       +
       module SearchSnippet = Jmap_search_snippet

     

       14
       14
       +
       

     

       15
       15
       +
       (* Identity *)

     

       16
       16
       +
       module Identity = Jmap_identity

     

       17
       17
       +
       

     

       18
       18
       +
       (* Email Submission *)

     

       19
       19
       +
       module Submission = Jmap_submission

     

       20
       20
       +
       

     

       21
       21
       +
       (* Vacation Response *)

     

       22
       22
       +
       module Vacation = Jmap_vacation

     

       23
       23
       +
       

     

       24
       24
       +
       (* Capability URI for JMAP Mail. *)

     

       25
       25
       +
       let capability_mail = "urn:ietf:params:jmap:mail"

     

       26
       26
       +
       

     

       27
       27
       +
       (* Capability URI for JMAP Submission. *)

     

       28
       28
       +
       let capability_submission = "urn:ietf:params:jmap:submission"

     

       29
       29
       +
       

     

       30
       30
       +
       (* Capability URI for JMAP Vacation Response. *)

     

       31
       31
       +
       let capability_vacationresponse = "urn:ietf:params:jmap:vacationresponse"

     

       32
       32
       +
       

     

       33
       33
       +
       (* Type name for EmailDelivery push notifications. *)

     

       34
       34
       +
       let push_event_type_email_delivery = "EmailDelivery"

     

       35
       35
       +
       

     

       36
       36
       +
       (* JMAP keywords corresponding to IMAP system flags. *)

     

       37
       37
       +
       let keyword_draft = "$draft"

     

       38
       38
       +
       let keyword_seen = "$seen"

     

       39
       39
       +
       let keyword_flagged = "$flagged"

     

       40
       40
       +
       let keyword_answered = "$answered"

     

       41
       41
       +
       

     

       42
       42
       +
       (* Common JMAP keywords from RFC 5788. *)

     

       43
       43
       +
       let keyword_forwarded = "$forwarded"

     

       44
       44
       +
       let keyword_phishing = "$phishing"

     

       45
       45
       +
       let keyword_junk = "$junk"

     

       46
       46
       +
       let keyword_notjunk = "$notjunk"

     

       47
       47
       +
       

     

       48
       48
       +
       (* Functions to manipulate email flags/keywords *)

     

       49
       49
       +
       module Keyword_ops = struct

     

       50
       50
       +
         let add email keyword =

     

       51
       51
       +
           match Types.Email.keywords email with

     

       52
       52
       +
           | None -> 

     

       53
       53
       +
               Types.Email.create 

     

       54
       54
       +
                 ?id:(Types.Email.id email) 

     

       55
       55
       +
                 ?blob_id:(Types.Email.blob_id email) 

     

       56
       56
       +
                 ?thread_id:(Types.Email.thread_id email) 

     

       57
       57
       +
                 ?mailbox_ids:(Types.Email.mailbox_ids email) 

     

       58
       58
       +
                 ~keywords:(Types.Keywords.of_list [keyword])

     

       59
       59
       +
                 ?size:(Types.Email.size email) 

     

       60
       60
       +
                 ?received_at:(Types.Email.received_at email)

     

       61
       61
       +
                 ?subject:(Types.Email.subject email) 

     

       62
       62
       +
                 ?preview:(Types.Email.preview email)

     

       63
       63
       +
                 ?from:(Types.Email.from email) 

     

       64
       64
       +
                 ?to_:(Types.Email.to_ email) 

     

       65
       65
       +
                 ?cc:(Types.Email.cc email)

     

       66
       66
       +
                 ?message_id:(Types.Email.message_id email) 

     

       67
       67
       +
                 ?has_attachment:(Types.Email.has_attachment email)

     

       68
       68
       +
                 ?text_body:(Types.Email.text_body email) 

     

       69
       69
       +
                 ?html_body:(Types.Email.html_body email)

     

       70
       70
       +
                 ?attachments:(Types.Email.attachments email)

     

       71
       71
       +
                 ()

     

       72
       72
       +
           | Some kws -> 

     

       73
       73
       +
               Types.Email.create 

     

       74
       74
       +
                 ?id:(Types.Email.id email) 

     

       75
       75
       +
                 ?blob_id:(Types.Email.blob_id email) 

     

       76
       76
       +
                 ?thread_id:(Types.Email.thread_id email) 

     

       77
       77
       +
                 ?mailbox_ids:(Types.Email.mailbox_ids email) 

     

       78
       78
       +
                 ~keywords:(Types.Keywords.add kws keyword)

     

       79
       79
       +
                 ?size:(Types.Email.size email) 

     

       80
       80
       +
                 ?received_at:(Types.Email.received_at email)

     

       81
       81
       +
                 ?subject:(Types.Email.subject email) 

     

       82
       82
       +
                 ?preview:(Types.Email.preview email)

     

       83
       83
       +
                 ?from:(Types.Email.from email) 

     

       84
       84
       +
                 ?to_:(Types.Email.to_ email) 

     

       85
       85
       +
                 ?cc:(Types.Email.cc email)

     

       86
       86
       +
                 ?message_id:(Types.Email.message_id email) 

     

       87
       87
       +
                 ?has_attachment:(Types.Email.has_attachment email)

     

       88
       88
       +
                 ?text_body:(Types.Email.text_body email) 

     

       89
       89
       +
                 ?html_body:(Types.Email.html_body email)

     

       90
       90
       +
                 ?attachments:(Types.Email.attachments email)

     

       91
       91
       +
                 ()

     

       92
       92
       +
         

     

       93
       93
       +
         let remove email keyword =

     

       94
       94
       +
           match Types.Email.keywords email with

     

       95
       95
       +
           | None -> email

     

       96
       96
       +
           | Some kws -> 

     

       97
       97
       +
               Types.Email.create 

     

       98
       98
       +
                 ?id:(Types.Email.id email) 

     

       99
       99
       +
                 ?blob_id:(Types.Email.blob_id email) 

     

       100
       100
       +
                 ?thread_id:(Types.Email.thread_id email) 

     

       101
       101
       +
                 ?mailbox_ids:(Types.Email.mailbox_ids email) 

     

       102
       102
       +
                 ~keywords:(Types.Keywords.remove kws keyword)

     

       103
       103
       +
                 ?size:(Types.Email.size email) 

     

       104
       104
       +
                 ?received_at:(Types.Email.received_at email)

     

       105
       105
       +
                 ?subject:(Types.Email.subject email) 

     

       106
       106
       +
                 ?preview:(Types.Email.preview email)

     

       107
       107
       +
                 ?from:(Types.Email.from email) 

     

       108
       108
       +
                 ?to_:(Types.Email.to_ email) 

     

       109
       109
       +
                 ?cc:(Types.Email.cc email)

     

       110
       110
       +
                 ?message_id:(Types.Email.message_id email) 

     

       111
       111
       +
                 ?has_attachment:(Types.Email.has_attachment email)

     

       112
       112
       +
                 ?text_body:(Types.Email.text_body email) 

     

       113
       113
       +
                 ?html_body:(Types.Email.html_body email)

     

       114
       114
       +
                 ?attachments:(Types.Email.attachments email)

     

       115
       115
       +
                 ()

     

       116
       116
       +
         

     

       117
       117
       +
         let mark_as_seen email = add email Types.Keywords.Seen

     

       118
       118
       +
         

     

       119
       119
       +
         let mark_as_unseen email = remove email Types.Keywords.Seen

     

       120
       120
       +
         

     

       121
       121
       +
         let mark_as_flagged email = add email Types.Keywords.Flagged

     

       122
       122
       +
         

     

       123
       123
       +
         let unmark_flagged email = remove email Types.Keywords.Flagged

     

       124
       124
       +
         

     

       125
       125
       +
         let mark_as_draft email = add email Types.Keywords.Draft

     

       126
       126
       +
         

     

       127
       127
       +
         let unmark_draft email = remove email Types.Keywords.Draft

     

       128
       128
       +
         

     

       129
       129
       +
         let mark_as_answered email = add email Types.Keywords.Answered

     

       130
       130
       +
         

     

       131
       131
       +
         let unmark_answered email = remove email Types.Keywords.Answered

     

       132
       132
       +
         

     

       133
       133
       +
         let mark_as_forwarded email = add email Types.Keywords.Forwarded

     

       134
       134
       +
         

     

       135
       135
       +
         let mark_as_junk email = add email Types.Keywords.Junk

     

       136
       136
       +
         

     

       137
       137
       +
         let mark_as_not_junk email = add email Types.Keywords.NotJunk

     

       138
       138
       +
         

     

       139
       139
       +
         let mark_as_phishing email = add email Types.Keywords.Phishing

     

       140
       140
       +
         

     

       141
       141
       +
         let add_custom email custom_kw = 

     

       142
       142
       +
           add email (Types.Keywords.Custom custom_kw)

     

       143
       143
       +
         

     

       144
       144
       +
         let remove_custom email custom_kw = 

     

       145
       145
       +
           remove email (Types.Keywords.Custom custom_kw)

     

       146
       146
       +
       

     

       147
       147
       +
         let add_keyword_patch keyword =

     

       148
       148
       +
           [("keywords/" ^ Types.Keywords.to_string keyword, `Bool true)]

     

       149
       149
       +
       

     

       150
       150
       +
         let remove_keyword_patch keyword =

     

       151
       151
       +
           [("keywords/" ^ Types.Keywords.to_string keyword, `Null)]

     

       152
       152
       +
       

     

       153
       153
       +
         let mark_seen_patch () =

     

       154
       154
       +
           add_keyword_patch Types.Keywords.Seen

     

       155
       155
       +
       

     

       156
       156
       +
         let mark_unseen_patch () =

     

       157
       157
       +
           remove_keyword_patch Types.Keywords.Seen

     

       158
       158
       +
       end

     

       159
       159
       +
       

     

       160
       160
       +
       (* Conversion functions for JMAP/IMAP compatibility *)

     

       161
       161
       +
       module Conversion = struct

     

       162
       162
       +
         let keyword_to_imap_flag = function

     

       163
       163
       +
           | Types.Keywords.Draft -> "\\Draft"

     

       164
       164
       +
           | Types.Keywords.Seen -> "\\Seen"

     

       165
       165
       +
           | Types.Keywords.Flagged -> "\\Flagged"

     

       166
       166
       +
           | Types.Keywords.Answered -> "\\Answered"

     

       167
       167
       +
           | Types.Keywords.Forwarded -> "$Forwarded"

     

       168
       168
       +
           | Types.Keywords.Phishing -> "$Phishing"

     

       169
       169
       +
           | Types.Keywords.Junk -> "$Junk"

     

       170
       170
       +
           | Types.Keywords.NotJunk -> "$NotJunk"

     

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

     

       172
       172
       +
         

     

       173
       173
       +
         let imap_flag_to_keyword = function

     

       174
       174
       +
           | "\\Draft" -> Types.Keywords.Draft

     

       175
       175
       +
           | "\\Seen" -> Types.Keywords.Seen

     

       176
       176
       +
           | "\\Flagged" -> Types.Keywords.Flagged

     

       177
       177
       +
           | "\\Answered" -> Types.Keywords.Answered

     

       178
       178
       +
           | "$Forwarded" -> Types.Keywords.Forwarded

     

       179
       179
       +
           | "$Phishing" -> Types.Keywords.Phishing

     

       180
       180
       +
           | "$Junk" -> Types.Keywords.Junk

     

       181
       181
       +
           | "$NotJunk" -> Types.Keywords.NotJunk

     

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

     

       183
       183
       +
         

     

       184
       184
       +
         let is_valid_custom_keyword s =

     

       185
       185
       +
           String.length s > 0 && s.[0] <> '$' &&

     

       186
       186
       +
           String.for_all (fun c -> 

     

       187
       187
       +
             (c >= 'a' && c <= 'z') || 

     

       188
       188
       +
             (c >= 'A' && c <= 'Z') || 

     

       189
       189
       +
             (c >= '0' && c <= '9') || 

     

       190
       190
       +
             c = '-' || c = '_') s

     

       191
       191
       +
         

     

       192
       192
       +
         let keyword_to_string = Types.Keywords.to_string

     

       193
       193
       +
         

     

       194
       194
       +
         let string_to_keyword = Types.Keywords.of_string

     

       195
       195
       +
       end

     

       196
       196
       +
       

     

       197
       197
       +
       (* Email query filter helpers *)

     

       198
       198
       +
       module Email_filter = struct

     

       199
       199
       +
         let in_mailbox mailbox_id =

     

       200
       200
       +
           let prop_name = "mailboxIds/" ^ mailbox_id in

     

       201
       201
       +
           Jmap.Methods.Filter.property_equals prop_name (`Bool true)

     

       202
       202
       +
         

     

       203
       203
       +
         let has_keyword keyword =

     

       204
       204
       +
           let prop_name = "keywords/" ^ Types.Keywords.to_string keyword in

     

       205
       205
       +
           Jmap.Methods.Filter.property_equals prop_name (`Bool true)

     

       206
       206
       +
         

     

       207
       207
       +
         let not_has_keyword keyword =

     

       208
       208
       +
           let prop_name = "keywords/" ^ Types.Keywords.to_string keyword in

     

       209
       209
       +
           Jmap.Methods.Filter.property_equals prop_name (`Bool false)

     

       210
       210
       +
         

     

       211
       211
       +
         let unread () =

     

       212
       212
       +
           not_has_keyword Types.Keywords.Seen

     

       213
       213
       +
         

     

       214
       214
       +
         let subject subject_text =

     

       215
       215
       +
           Jmap.Methods.Filter.text_contains "subject" subject_text

     

       216
       216
       +
         

     

       217
       217
       +
         let from email =

     

       218
       218
       +
           Jmap.Methods.Filter.text_contains "from" email

     

       219
       219
       +
         

     

       220
       220
       +
         let to_ email =

     

       221
       221
       +
           Jmap.Methods.Filter.text_contains "to" email

     

       222
       222
       +
         

     

       223
       223
       +
         let has_attachment () =

     

       224
       224
       +
           Jmap.Methods.Filter.property_equals "hasAttachment" (`Bool true)

     

       225
       225
       +
         

     

       226
       226
       +
         let before date =

     

       227
       227
       +
           Jmap.Methods.Filter.property_lt "receivedAt" (`Float date)

     

       228
       228
       +
         

     

       229
       229
       +
         let after date =

     

       230
       230
       +
           Jmap.Methods.Filter.property_gt "receivedAt" (`Float date)

     

       231
       231
       +
         

     

       232
       232
       +
         let larger_than size =

     

       233
       233
       +
           Jmap.Methods.Filter.property_gt "size" (`Int size)

     

       234
       234
       +
         

     

       235
       235
       +
         let smaller_than size =

     

       236
       236
       +
           Jmap.Methods.Filter.property_lt "size" (`Int size)

     

       237
       237
       +
       end

     

       238
       238
       +
       

     

       239
       239
       +
       (* Common email sorting comparators *)

     

       240
       240
       +
       module Email_sort = struct

     

       241
       241
       +
         let received_newest_first () =

     

       242
       242
       +
           Jmap.Methods.Comparator.v 

     

       243
       243
       +
             ~property:"receivedAt" 

     

       244
       244
       +
             ~is_ascending:false

     

       245
       245
       +
             ()

     

       246
       246
       +
         

     

       247
       247
       +
         let received_oldest_first () =

     

       248
       248
       +
           Jmap.Methods.Comparator.v 

     

       249
       249
       +
             ~property:"receivedAt" 

     

       250
       250
       +
             ~is_ascending:true

     

       251
       251
       +
             ()

     

       252
       252
       +
         

     

       253
       253
       +
         let sent_newest_first () =

     

       254
       254
       +
           Jmap.Methods.Comparator.v 

     

       255
       255
       +
             ~property:"sentAt" 

     

       256
       256
       +
             ~is_ascending:false

     

       257
       257
       +
             ()

     

       258
       258
       +
         

     

       259
       259
       +
         let sent_oldest_first () =

     

       260
       260
       +
           Jmap.Methods.Comparator.v 

     

       261
       261
       +
             ~property:"sentAt" 

     

       262
       262
       +
             ~is_ascending:true

     

       263
       263
       +
             ()

     

       264
       264
       +
         

     

       265
       265
       +
         let subject_asc () =

     

       266
       266
       +
           Jmap.Methods.Comparator.v 

     

       267
       267
       +
             ~property:"subject" 

     

       268
       268
       +
             ~is_ascending:true

     

       269
       269
       +
             ()

     

       270
       270
       +
         

     

       271
       271
       +
         let subject_desc () =

     

       272
       272
       +
           Jmap.Methods.Comparator.v 

     

       273
       273
       +
             ~property:"subject" 

     

       274
       274
       +
             ~is_ascending:false

     

       275
       275
       +
             ()

     

       276
       276
       +
         

     

       277
       277
       +
         let size_largest_first () =

     

       278
       278
       +
           Jmap.Methods.Comparator.v 

     

       279
       279
       +
             ~property:"size" 

     

       280
       280
       +
             ~is_ascending:false

     

       281
       281
       +
             ()

     

       282
       282
       +
         

     

       283
       283
       +
         let size_smallest_first () =

     

       284
       284
       +
           Jmap.Methods.Comparator.v 

     

       285
       285
       +
             ~property:"size" 

     

       286
       286
       +
             ~is_ascending:true

     

       287
       287
       +
             ()

     

       288
       288
       +
         

     

       289
       289
       +
         let from_asc () =

     

       290
       290
       +
           Jmap.Methods.Comparator.v 

     

       291
       291
       +
             ~property:"from" 

     

       292
       292
       +
             ~is_ascending:true

     

       293
       293
       +
             ()

     

       294
       294
       +
         

     

       295
       295
       +
         let from_desc () =

     

       296
       296
       +
           Jmap.Methods.Comparator.v 

     

       297
       297
       +
             ~property:"from" 

     

       298
       298
       +
             ~is_ascending:false

     

       299
       299
       +
             ()

     

       300
       300
       +
       end

+314

jmap-email/jmap_email.mli

···

       1
       1
       +
       (** JMAP Mail Extension Library (RFC 8621).

     

       2
       2
       +
       

     

       3
       3
       +
           This library extends the core JMAP protocol with email-specific

     

       4
       4
       +
           functionality as defined in RFC 8621. It provides types and signatures

     

       5
       5
       +
           for interacting with JMAP Mail data types: Mailbox, Thread, Email, 

     

       6
       6
       +
           SearchSnippet, Identity, EmailSubmission, and VacationResponse.

     

       7
       7
       +
           

     

       8
       8
       +
           Requires the core Jmap library and Jmap_unix library for network operations.

     

       9
       9
       +
           

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail

     

       11
       11
       +
       *)

     

       12
       12
       +
       

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       

     

       15
       15
       +
       (** {1 Core Types} *)

     

       16
       16
       +
       module Types = Jmap_email_types

     

       17
       17
       +
       

     

       18
       18
       +
       (** {1 Mailbox} 

     

       19
       19
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       20
       20
       +
       module Mailbox = Jmap_mailbox

     

       21
       21
       +
       

     

       22
       22
       +
       (** {1 Thread}

     

       23
       23
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       24
       24
       +
       module Thread = Jmap_thread

     

       25
       25
       +
       

     

       26
       26
       +
       (** {1 Search Snippet}

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       28
       28
       +
       module SearchSnippet = Jmap_search_snippet

     

       29
       29
       +
       

     

       30
       30
       +
       (** {1 Identity}

     

       31
       31
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       32
       32
       +
       module Identity = Jmap_identity

     

       33
       33
       +
       

     

       34
       34
       +
       (** {1 Email Submission}

     

       35
       35
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       36
       36
       +
       module Submission = Jmap_submission

     

       37
       37
       +
       

     

       38
       38
       +
       (** {1 Vacation Response}

     

       39
       39
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       40
       40
       +
       module Vacation = Jmap_vacation

     

       41
       41
       +
       

     

       42
       42
       +
       (** {1 Example Usage}

     

       43
       43
       +
       

     

       44
       44
       +
           The following example demonstrates using the JMAP Email library to fetch unread emails

     

       45
       45
       +
           from a specific sender.

     

       46
       46
       +
       

     

       47
       47
       +
       {[

     

       48
       48
       +
         (* OCaml 5.1 required for Lwt let operators *)

     

       49
       49
       +
         open Lwt.Syntax

     

       50
       50
       +
         open Jmap

     

       51
       51
       +
         open Jmap.Types

     

       52
       52
       +
         open Jmap.Wire

     

       53
       53
       +
         open Jmap.Methods

     

       54
       54
       +
         open Jmap_email

     

       55
       55
       +
         open Jmap.Unix

     

       56
       56
       +
         

     

       57
       57
       +
         let list_unread_from_sender ctx session sender_email =

     

       58
       58
       +
           (* Find the primary mail account *)

     

       59
       59
       +
           let primary_mail_account_id =

     

       60
       60
       +
             Hashtbl.find session.primary_accounts capability_mail

     

       61
       61
       +
           in

     

       62
       62
       +
           (* Construct the filter *)

     

       63
       63
       +
           let filter : filter =

     

       64
       64
       +
             Filter_operator (Filter_operator.v

     

       65
       65
       +
               ~operator:`AND

     

       66
       66
       +
               ~conditions:[

     

       67
       67
       +
                 Filter_condition (Yojson.Safe.to_basic (`Assoc [

     

       68
       68
       +
                   ("from", `String sender_email);

     

       69
       69
       +
                 ]));

     

       70
       70
       +
                 Filter_condition (Yojson.Safe.to_basic (`Assoc [

     

       71
       71
       +
                   ("hasKeyword", `String keyword_seen);

     

       72
       72
       +
                   ("value", `Bool false);

     

       73
       73
       +
                 ]));

     

       74
       74
       +
               ]

     

       75
       75
       +
               ())

     

       76
       76
       +
           in

     

       77
       77
       +
           (* Prepare the Email/query invocation *)

     

       78
       78
       +
           let query_args = Query_args.v

     

       79
       79
       +
             ~account_id:primary_mail_account_id

     

       80
       80
       +
             ~filter

     

       81
       81
       +
             ~sort:[

     

       82
       82
       +
               Comparator.v

     

       83
       83
       +
                 ~property:"receivedAt"

     

       84
       84
       +
                 ~is_ascending:false

     

       85
       85
       +
                 ()

     

       86
       86
       +
             ]

     

       87
       87
       +
             ~position:0

     

       88
       88
       +
             ~limit:20 (* Get latest 20 *)

     

       89
       89
       +
             ~calculate_total:false

     

       90
       90
       +
             ~collapse_threads:false

     

       91
       91
       +
             ()

     

       92
       92
       +
           in

     

       93
       93
       +
           let query_invocation = Invocation.v

     

       94
       94
       +
             ~method_name:"Email/query"

     

       95
       95
       +
             ~arguments:(* Yojson conversion of query_args needed here *)

     

       96
       96
       +
             ~method_call_id:"q1"

     

       97
       97
       +
             ()

     

       98
       98
       +
           in

     

       99
       99
       +
       

     

       100
       100
       +
           (* Prepare the Email/get invocation using a back-reference *)

     

       101
       101
       +
           let get_args = Get_args.v

     

       102
       102
       +
             ~account_id:primary_mail_account_id

     

       103
       103
       +
             ~properties:["id"; "subject"; "receivedAt"; "from"]

     

       104
       104
       +
             ()

     

       105
       105
       +
           in

     

       106
       106
       +
           let get_invocation = Invocation.v

     

       107
       107
       +
             ~method_name:"Email/get"

     

       108
       108
       +
             ~arguments:(* Yojson conversion of get_args, with ids replaced by a ResultReference to q1 needed here *)

     

       109
       109
       +
             ~method_call_id:"g1"

     

       110
       110
       +
             ()

     

       111
       111
       +
           in

     

       112
       112
       +
       

     

       113
       113
       +
           (* Prepare the JMAP request *)

     

       114
       114
       +
           let request = Request.v

     

       115
       115
       +
             ~using:[ Jmap.capability_core; capability_mail ]

     

       116
       116
       +
             ~method_calls:[ query_invocation; get_invocation ]

     

       117
       117
       +
             ()

     

       118
       118
       +
           in

     

       119
       119
       +
       

     

       120
       120
       +
           (* Send the request *)

     

       121
       121
       +
           let* response = Jmap.Unix.request ctx request in

     

       122
       122
       +
       

     

       123
       123
       +
           (* Process the response (extract Email/get results) *)

     

       124
       124
       +
           (* ... Omitted: find the Email/get response in response.method_responses ... *)

     

       125
       125
       +
           Lwt.return_unit

     

       126
       126
       +
       ]}

     

       127
       127
       +
       *)

     

       128
       128
       +
       

     

       129
       129
       +
       (** Capability URI for JMAP Mail.

     

       130
       130
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.1> RFC 8621, Section 1.3.1 *)

     

       131
       131
       +
       val capability_mail : string

     

       132
       132
       +
       

     

       133
       133
       +
       (** Capability URI for JMAP Submission.

     

       134
       134
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.2> RFC 8621, Section 1.3.2 *)

     

       135
       135
       +
       val capability_submission : string

     

       136
       136
       +
       

     

       137
       137
       +
       (** Capability URI for JMAP Vacation Response.

     

       138
       138
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.3> RFC 8621, Section 1.3.3 *)

     

       139
       139
       +
       val capability_vacationresponse : string

     

       140
       140
       +
       

     

       141
       141
       +
       (** Type name for EmailDelivery push notifications.

     

       142
       142
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.5> RFC 8621, Section 1.5 *)

     

       143
       143
       +
       val push_event_type_email_delivery : string

     

       144
       144
       +
       

     

       145
       145
       +
       (** JMAP keywords corresponding to IMAP system flags.

     

       146
       146
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       147
       147
       +
       val keyword_draft : string

     

       148
       148
       +
       val keyword_seen : string

     

       149
       149
       +
       val keyword_flagged : string

     

       150
       150
       +
       val keyword_answered : string

     

       151
       151
       +
       

     

       152
       152
       +
       (** Common JMAP keywords from RFC 5788.

     

       153
       153
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       154
       154
       +
       val keyword_forwarded : string

     

       155
       155
       +
       val keyword_phishing : string

     

       156
       156
       +
       val keyword_junk : string

     

       157
       157
       +
       val keyword_notjunk : string

     

       158
       158
       +
       

     

       159
       159
       +
       (** Functions to manipulate email flags/keywords *)

     

       160
       160
       +
       module Keyword_ops : sig

     

       161
       161
       +
         (** Add a keyword/flag to an email *)

     

       162
       162
       +
         val add : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t

     

       163
       163
       +
         

     

       164
       164
       +
         (** Remove a keyword/flag from an email *)

     

       165
       165
       +
         val remove : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t

     

       166
       166
       +
         

     

       167
       167
       +
         (** Mark an email as seen/read *)

     

       168
       168
       +
         val mark_as_seen : Types.Email.t -> Types.Email.t

     

       169
       169
       +
         

     

       170
       170
       +
         (** Mark an email as unseen/unread *)

     

       171
       171
       +
         val mark_as_unseen : Types.Email.t -> Types.Email.t

     

       172
       172
       +
         

     

       173
       173
       +
         (** Mark an email as flagged/important *)

     

       174
       174
       +
         val mark_as_flagged : Types.Email.t -> Types.Email.t

     

       175
       175
       +
         

     

       176
       176
       +
         (** Remove flagged/important marking from an email *)

     

       177
       177
       +
         val unmark_flagged : Types.Email.t -> Types.Email.t

     

       178
       178
       +
         

     

       179
       179
       +
         (** Mark an email as a draft *)

     

       180
       180
       +
         val mark_as_draft : Types.Email.t -> Types.Email.t

     

       181
       181
       +
         

     

       182
       182
       +
         (** Remove draft marking from an email *)

     

       183
       183
       +
         val unmark_draft : Types.Email.t -> Types.Email.t

     

       184
       184
       +
         

     

       185
       185
       +
         (** Mark an email as answered/replied *)

     

       186
       186
       +
         val mark_as_answered : Types.Email.t -> Types.Email.t

     

       187
       187
       +
         

     

       188
       188
       +
         (** Remove answered/replied marking from an email *)

     

       189
       189
       +
         val unmark_answered : Types.Email.t -> Types.Email.t

     

       190
       190
       +
         

     

       191
       191
       +
         (** Mark an email as forwarded *)

     

       192
       192
       +
         val mark_as_forwarded : Types.Email.t -> Types.Email.t

     

       193
       193
       +
         

     

       194
       194
       +
         (** Mark an email as spam/junk *)

     

       195
       195
       +
         val mark_as_junk : Types.Email.t -> Types.Email.t

     

       196
       196
       +
         

     

       197
       197
       +
         (** Mark an email as not spam/junk *)

     

       198
       198
       +
         val mark_as_not_junk : Types.Email.t -> Types.Email.t

     

       199
       199
       +
         

     

       200
       200
       +
         (** Mark an email as phishing *)

     

       201
       201
       +
         val mark_as_phishing : Types.Email.t -> Types.Email.t

     

       202
       202
       +
         

     

       203
       203
       +
         (** Add a custom keyword to an email *)

     

       204
       204
       +
         val add_custom : Types.Email.t -> string -> Types.Email.t

     

       205
       205
       +
         

     

       206
       206
       +
         (** Remove a custom keyword from an email *)

     

       207
       207
       +
         val remove_custom : Types.Email.t -> string -> Types.Email.t

     

       208
       208
       +
       

     

       209
       209
       +
         (** Create a patch object to add a keyword to emails *)

     

       210
       210
       +
         val add_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object

     

       211
       211
       +
       

     

       212
       212
       +
         (** Create a patch object to remove a keyword from emails *)

     

       213
       213
       +
         val remove_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object

     

       214
       214
       +
       

     

       215
       215
       +
         (** Create a patch object to mark emails as seen/read *)

     

       216
       216
       +
         val mark_seen_patch : unit -> Jmap.Methods.patch_object

     

       217
       217
       +
       

     

       218
       218
       +
         (** Create a patch object to mark emails as unseen/unread *)

     

       219
       219
       +
         val mark_unseen_patch : unit -> Jmap.Methods.patch_object

     

       220
       220
       +
       end

     

       221
       221
       +
       

     

       222
       222
       +
       (** Conversion functions for JMAP/IMAP compatibility *)

     

       223
       223
       +
       module Conversion : sig

     

       224
       224
       +
         (** Convert a JMAP keyword variant to IMAP flag *)

     

       225
       225
       +
         val keyword_to_imap_flag : Types.Keywords.keyword -> string

     

       226
       226
       +
         

     

       227
       227
       +
         (** Convert an IMAP flag to JMAP keyword variant *)

     

       228
       228
       +
         val imap_flag_to_keyword : string -> Types.Keywords.keyword

     

       229
       229
       +
         

     

       230
       230
       +
         (** Check if a string is valid for use as a custom keyword according to RFC 8621 *)

     

       231
       231
       +
         val is_valid_custom_keyword : string -> bool

     

       232
       232
       +
         

     

       233
       233
       +
         (** Get the JMAP protocol string representation of a keyword *)

     

       234
       234
       +
         val keyword_to_string : Types.Keywords.keyword -> string

     

       235
       235
       +
         

     

       236
       236
       +
         (** Parse a JMAP protocol string into a keyword variant *)

     

       237
       237
       +
         val string_to_keyword : string -> Types.Keywords.keyword

     

       238
       238
       +
       end

     

       239
       239
       +
       

     

       240
       240
       +
       (** {1 Helper Functions} *)

     

       241
       241
       +
       

     

       242
       242
       +
       (** Email query filter helpers *)

     

       243
       243
       +
       module Email_filter : sig

     

       244
       244
       +
         (** Create a filter to find messages in a specific mailbox *)

     

       245
       245
       +
         val in_mailbox : id -> Jmap.Methods.Filter.t

     

       246
       246
       +
         

     

       247
       247
       +
         (** Create a filter to find messages with a specific keyword/flag *)

     

       248
       248
       +
         val has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t

     

       249
       249
       +
         

     

       250
       250
       +
         (** Create a filter to find messages without a specific keyword/flag *)

     

       251
       251
       +
         val not_has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t

     

       252
       252
       +
         

     

       253
       253
       +
         (** Create a filter to find unread messages *)

     

       254
       254
       +
         val unread : unit -> Jmap.Methods.Filter.t

     

       255
       255
       +
         

     

       256
       256
       +
         (** Create a filter to find messages with a specific subject *)

     

       257
       257
       +
         val subject : string -> Jmap.Methods.Filter.t

     

       258
       258
       +
         

     

       259
       259
       +
         (** Create a filter to find messages from a specific sender *)

     

       260
       260
       +
         val from : string -> Jmap.Methods.Filter.t

     

       261
       261
       +
         

     

       262
       262
       +
         (** Create a filter to find messages sent to a specific recipient *)

     

       263
       263
       +
         val to_ : string -> Jmap.Methods.Filter.t

     

       264
       264
       +
         

     

       265
       265
       +
         (** Create a filter to find messages with attachments *)

     

       266
       266
       +
         val has_attachment : unit -> Jmap.Methods.Filter.t

     

       267
       267
       +
         

     

       268
       268
       +
         (** Create a filter to find messages received before a date *)

     

       269
       269
       +
         val before : date -> Jmap.Methods.Filter.t

     

       270
       270
       +
         

     

       271
       271
       +
         (** Create a filter to find messages received after a date *)

     

       272
       272
       +
         val after : date -> Jmap.Methods.Filter.t

     

       273
       273
       +
         

     

       274
       274
       +
         (** Create a filter to find messages with size larger than the given bytes *)

     

       275
       275
       +
         val larger_than : uint -> Jmap.Methods.Filter.t

     

       276
       276
       +
         

     

       277
       277
       +
         (** Create a filter to find messages with size smaller than the given bytes *)

     

       278
       278
       +
         val smaller_than : uint -> Jmap.Methods.Filter.t

     

       279
       279
       +
       end

     

       280
       280
       +
       

     

       281
       281
       +
       (** Common email sorting comparators *)

     

       282
       282
       +
       module Email_sort : sig

     

       283
       283
       +
         (** Sort by received date (most recent first) *)

     

       284
       284
       +
         val received_newest_first : unit -> Jmap.Methods.Comparator.t

     

       285
       285
       +
         

     

       286
       286
       +
         (** Sort by received date (oldest first) *)

     

       287
       287
       +
         val received_oldest_first : unit -> Jmap.Methods.Comparator.t

     

       288
       288
       +
         

     

       289
       289
       +
         (** Sort by sent date (most recent first) *)

     

       290
       290
       +
         val sent_newest_first : unit -> Jmap.Methods.Comparator.t

     

       291
       291
       +
         

     

       292
       292
       +
         (** Sort by sent date (oldest first) *)

     

       293
       293
       +
         val sent_oldest_first : unit -> Jmap.Methods.Comparator.t

     

       294
       294
       +
         

     

       295
       295
       +
         (** Sort by subject (A-Z) *)

     

       296
       296
       +
         val subject_asc : unit -> Jmap.Methods.Comparator.t

     

       297
       297
       +
         

     

       298
       298
       +
         (** Sort by subject (Z-A) *)

     

       299
       299
       +
         val subject_desc : unit -> Jmap.Methods.Comparator.t

     

       300
       300
       +
         

     

       301
       301
       +
         (** Sort by size (largest first) *)

     

       302
       302
       +
         val size_largest_first : unit -> Jmap.Methods.Comparator.t

     

       303
       303
       +
         

     

       304
       304
       +
         (** Sort by size (smallest first) *)

     

       305
       305
       +
         val size_smallest_first : unit -> Jmap.Methods.Comparator.t

     

       306
       306
       +
         

     

       307
       307
       +
         (** Sort by from address (A-Z) *)

     

       308
       308
       +
         val from_asc : unit -> Jmap.Methods.Comparator.t

     

       309
       309
       +
         

     

       310
       310
       +
         (** Sort by from address (Z-A) *)

     

       311
       311
       +
         val from_desc : unit -> Jmap.Methods.Comparator.t

     

       312
       312
       +
       end

     

       313
       313
       +
       

     

       314
       314
       +
       (** High-level email operations are implemented in the Jmap.Unix.Email module *)

+405

jmap-email/jmap_email_types.ml

···

       1
       1
       +
       (* Common types for JMAP Mail (RFC 8621). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       

     

       5
       5
       +
       (* Represents an email address with an optional name. *)

     

       6
       6
       +
       module Email_address = struct

     

       7
       7
       +
         type t = {

     

       8
       8
       +
           name: string option;

     

       9
       9
       +
           email: string;

     

       10
       10
       +
         }

     

       11
       11
       +
       

     

       12
       12
       +
         let name t = t.name

     

       13
       13
       +
         let email t = t.email

     

       14
       14
       +
         

     

       15
       15
       +
         let v ?name ~email () = { name; email }

     

       16
       16
       +
       end

     

       17
       17
       +
       

     

       18
       18
       +
       (* Represents a group of email addresses. *)

     

       19
       19
       +
       module Email_address_group = struct

     

       20
       20
       +
         type t = {

     

       21
       21
       +
           name: string option;

     

       22
       22
       +
           addresses: Email_address.t list;

     

       23
       23
       +
         }

     

       24
       24
       +
         

     

       25
       25
       +
         let name t = t.name

     

       26
       26
       +
         let addresses t = t.addresses

     

       27
       27
       +
         

     

       28
       28
       +
         let v ?name ~addresses () = { name; addresses }

     

       29
       29
       +
       end

     

       30
       30
       +
       

     

       31
       31
       +
       (* Represents a header field (name and raw value). *)

     

       32
       32
       +
       module Email_header = struct

     

       33
       33
       +
         type t = {

     

       34
       34
       +
           name: string;

     

       35
       35
       +
           value: string;

     

       36
       36
       +
         }

     

       37
       37
       +
         

     

       38
       38
       +
         let name t = t.name

     

       39
       39
       +
         let value t = t.value

     

       40
       40
       +
         

     

       41
       41
       +
         let v ~name ~value () = { name; value }

     

       42
       42
       +
       end

     

       43
       43
       +
       

     

       44
       44
       +
       (* Represents a body part within an Email's MIME structure. *)

     

       45
       45
       +
       module Email_body_part = struct

     

       46
       46
       +
         type t = {

     

       47
       47
       +
           id: string option;

     

       48
       48
       +
           blob_id: id option;

     

       49
       49
       +
           size: uint;

     

       50
       50
       +
           headers: Email_header.t list;

     

       51
       51
       +
           name: string option;

     

       52
       52
       +
           mime_type: string;

     

       53
       53
       +
           charset: string option;

     

       54
       54
       +
           disposition: string option;

     

       55
       55
       +
           cid: string option;

     

       56
       56
       +
           language: string list option;

     

       57
       57
       +
           location: string option;

     

       58
       58
       +
           sub_parts: t list option;

     

       59
       59
       +
           other_headers: Yojson.Safe.t string_map;

     

       60
       60
       +
         }

     

       61
       61
       +
         

     

       62
       62
       +
         let id t = t.id

     

       63
       63
       +
         let blob_id t = t.blob_id

     

       64
       64
       +
         let size t = t.size

     

       65
       65
       +
         let headers t = t.headers

     

       66
       66
       +
         let name t = t.name

     

       67
       67
       +
         let mime_type t = t.mime_type

     

       68
       68
       +
         let charset t = t.charset

     

       69
       69
       +
         let disposition t = t.disposition

     

       70
       70
       +
         let cid t = t.cid

     

       71
       71
       +
         let language t = t.language

     

       72
       72
       +
         let location t = t.location

     

       73
       73
       +
         let sub_parts t = t.sub_parts

     

       74
       74
       +
         let other_headers t = t.other_headers

     

       75
       75
       +
         

     

       76
       76
       +
         let v ?id ?blob_id ~size ~headers ?name ~mime_type ?charset

     

       77
       77
       +
             ?disposition ?cid ?language ?location ?sub_parts

     

       78
       78
       +
             ?(other_headers=Hashtbl.create 0) () =

     

       79
       79
       +
           { id; blob_id; size; headers; name; mime_type; charset;

     

       80
       80
       +
             disposition; cid; language; location; sub_parts; other_headers }

     

       81
       81
       +
       end

     

       82
       82
       +
       

     

       83
       83
       +
       (* Represents the decoded value of a text body part. *)

     

       84
       84
       +
       module Email_body_value = struct

     

       85
       85
       +
         type t = {

     

       86
       86
       +
           value: string;

     

       87
       87
       +
           has_encoding_problem: bool;

     

       88
       88
       +
           is_truncated: bool;

     

       89
       89
       +
         }

     

       90
       90
       +
         

     

       91
       91
       +
         let value t = t.value

     

       92
       92
       +
         let has_encoding_problem t = t.has_encoding_problem

     

       93
       93
       +
         let is_truncated t = t.is_truncated

     

       94
       94
       +
         

     

       95
       95
       +
         let v ~value ?(encoding_problem=false) ?(truncated=false) () =

     

       96
       96
       +
           { value; has_encoding_problem = encoding_problem; is_truncated = truncated }

     

       97
       97
       +
       end

     

       98
       98
       +
       

     

       99
       99
       +
       (* Type to represent email message flags/keywords. *)

     

       100
       100
       +
       module Keywords = struct

     

       101
       101
       +
         type keyword =

     

       102
       102
       +
           | Draft      (* "$draft": The Email is a draft the user is composing *)

     

       103
       103
       +
           | Seen       (* "$seen": The Email has been read *)

     

       104
       104
       +
           | Flagged    (* "$flagged": The Email has been flagged for urgent/special attention *)

     

       105
       105
       +
           | Answered   (* "$answered": The Email has been replied to *)

     

       106
       106
       +
           

     

       107
       107
       +
           (* Common extension keywords from RFC 5788 *)

     

       108
       108
       +
           | Forwarded  (* "$forwarded": The Email has been forwarded *)

     

       109
       109
       +
           | Phishing   (* "$phishing": The Email is likely to be phishing *)

     

       110
       110
       +
           | Junk       (* "$junk": The Email is spam/junk *)

     

       111
       111
       +
           | NotJunk    (* "$notjunk": The Email is explicitly marked as not spam/junk *)

     

       112
       112
       +
           | Custom of string  (* Arbitrary user-defined keyword *)

     

       113
       113
       +
       

     

       114
       114
       +
         type t = keyword list

     

       115
       115
       +
       

     

       116
       116
       +
         let is_draft keywords =

     

       117
       117
       +
           List.exists (function Draft -> true | _ -> false) keywords

     

       118
       118
       +
         

     

       119
       119
       +
         let is_seen keywords =

     

       120
       120
       +
           List.exists (function Seen -> true | _ -> false) keywords

     

       121
       121
       +
         

     

       122
       122
       +
         let is_unread keywords =

     

       123
       123
       +
           not (is_seen keywords || is_draft keywords)

     

       124
       124
       +
         

     

       125
       125
       +
         let is_flagged keywords =

     

       126
       126
       +
           List.exists (function Flagged -> true | _ -> false) keywords

     

       127
       127
       +
         

     

       128
       128
       +
         let is_answered keywords =

     

       129
       129
       +
           List.exists (function Answered -> true | _ -> false) keywords

     

       130
       130
       +
         

     

       131
       131
       +
         let is_forwarded keywords =

     

       132
       132
       +
           List.exists (function Forwarded -> true | _ -> false) keywords

     

       133
       133
       +
         

     

       134
       134
       +
         let is_phishing keywords =

     

       135
       135
       +
           List.exists (function Phishing -> true | _ -> false) keywords

     

       136
       136
       +
         

     

       137
       137
       +
         let is_junk keywords =

     

       138
       138
       +
           List.exists (function Junk -> true | _ -> false) keywords

     

       139
       139
       +
         

     

       140
       140
       +
         let is_not_junk keywords =

     

       141
       141
       +
           List.exists (function NotJunk -> true | _ -> false) keywords

     

       142
       142
       +
         

     

       143
       143
       +
         let has_keyword keywords custom_keyword =

     

       144
       144
       +
           List.exists (function Custom k when k = custom_keyword -> true | _ -> false) keywords

     

       145
       145
       +
         

     

       146
       146
       +
         let custom_keywords keywords =

     

       147
       147
       +
           List.fold_left (fun acc kw ->

     

       148
       148
       +
             match kw with

     

       149
       149
       +
             | Custom k -> k :: acc

     

       150
       150
       +
             | _ -> acc

     

       151
       151
       +
           ) [] keywords

     

       152
       152
       +
         

     

       153
       153
       +
         let add keywords keyword =

     

       154
       154
       +
           if List.exists (fun k -> k = keyword) keywords then

     

       155
       155
       +
             keywords

     

       156
       156
       +
           else

     

       157
       157
       +
             keyword :: keywords

     

       158
       158
       +
         

     

       159
       159
       +
         let remove keywords keyword =

     

       160
       160
       +
           List.filter (fun k -> k <> keyword) keywords

     

       161
       161
       +
         

     

       162
       162
       +
         let empty () = []

     

       163
       163
       +
         

     

       164
       164
       +
         let of_list keywords = keywords

     

       165
       165
       +
         

     

       166
       166
       +
         let to_string = function

     

       167
       167
       +
           | Draft -> "$draft"

     

       168
       168
       +
           | Seen -> "$seen"

     

       169
       169
       +
           | Flagged -> "$flagged"

     

       170
       170
       +
           | Answered -> "$answered"

     

       171
       171
       +
           | Forwarded -> "$forwarded"

     

       172
       172
       +
           | Phishing -> "$phishing"

     

       173
       173
       +
           | Junk -> "$junk"

     

       174
       174
       +
           | NotJunk -> "$notjunk"

     

       175
       175
       +
           | Custom k -> k

     

       176
       176
       +
         

     

       177
       177
       +
         let of_string s =

     

       178
       178
       +
           match s with

     

       179
       179
       +
           | "$draft" -> Draft

     

       180
       180
       +
           | "$seen" -> Seen

     

       181
       181
       +
           | "$flagged" -> Flagged

     

       182
       182
       +
           | "$answered" -> Answered

     

       183
       183
       +
           | "$forwarded" -> Forwarded

     

       184
       184
       +
           | "$phishing" -> Phishing

     

       185
       185
       +
           | "$junk" -> Junk

     

       186
       186
       +
           | "$notjunk" -> NotJunk

     

       187
       187
       +
           | k -> Custom k

     

       188
       188
       +
         

     

       189
       189
       +
         let to_map keywords =

     

       190
       190
       +
           let map = Hashtbl.create (List.length keywords) in

     

       191
       191
       +
           List.iter (fun kw ->

     

       192
       192
       +
             Hashtbl.add map (to_string kw) true

     

       193
       193
       +
           ) keywords;

     

       194
       194
       +
           map

     

       195
       195
       +
       end

     

       196
       196
       +
       

     

       197
       197
       +
       (* Email properties enum. *)

     

       198
       198
       +
       type email_property =

     

       199
       199
       +
         | Id               (* The id of the email *)

     

       200
       200
       +
         | BlobId           (* The id of the blob containing the raw message *)

     

       201
       201
       +
         | ThreadId         (* The id of the thread this email belongs to *)

     

       202
       202
       +
         | MailboxIds       (* The mailboxes this email belongs to *)

     

       203
       203
       +
         | Keywords         (* The keywords/flags for this email *)

     

       204
       204
       +
         | Size             (* Size of the message in bytes *)

     

       205
       205
       +
         | ReceivedAt       (* When the message was received by the server *)

     

       206
       206
       +
         | MessageId        (* Value of the Message-ID header *)

     

       207
       207
       +
         | InReplyTo        (* Value of the In-Reply-To header *)

     

       208
       208
       +
         | References       (* Value of the References header *)

     

       209
       209
       +
         | Sender           (* Value of the Sender header *)

     

       210
       210
       +
         | From             (* Value of the From header *)

     

       211
       211
       +
         | To               (* Value of the To header *)

     

       212
       212
       +
         | Cc               (* Value of the Cc header *)

     

       213
       213
       +
         | Bcc              (* Value of the Bcc header *)

     

       214
       214
       +
         | ReplyTo          (* Value of the Reply-To header *)

     

       215
       215
       +
         | Subject          (* Value of the Subject header *)

     

       216
       216
       +
         | SentAt           (* Value of the Date header *)

     

       217
       217
       +
         | HasAttachment    (* Whether the email has attachments *)

     

       218
       218
       +
         | Preview          (* Preview text of the email *)

     

       219
       219
       +
         | BodyStructure    (* MIME structure of the email *)

     

       220
       220
       +
         | BodyValues       (* Decoded body part values *)

     

       221
       221
       +
         | TextBody         (* Text body parts *)

     

       222
       222
       +
         | HtmlBody         (* HTML body parts *)

     

       223
       223
       +
         | Attachments      (* Attachments *)

     

       224
       224
       +
         | Header of string (* Specific header *)

     

       225
       225
       +
         | Other of string  (* Extension property *)

     

       226
       226
       +
       

     

       227
       227
       +
       (* Represents an Email object. *)

     

       228
       228
       +
       module Email = struct

     

       229
       229
       +
         type t = {

     

       230
       230
       +
           id: id option;

     

       231
       231
       +
           blob_id: id option;

     

       232
       232
       +
           thread_id: id option;

     

       233
       233
       +
           mailbox_ids: bool id_map option;

     

       234
       234
       +
           keywords: Keywords.t option;

     

       235
       235
       +
           size: uint option;

     

       236
       236
       +
           received_at: date option;

     

       237
       237
       +
           subject: string option;

     

       238
       238
       +
           preview: string option;

     

       239
       239
       +
           from: Email_address.t list option;

     

       240
       240
       +
           to_: Email_address.t list option;

     

       241
       241
       +
           cc: Email_address.t list option;

     

       242
       242
       +
           message_id: string list option;

     

       243
       243
       +
           has_attachment: bool option;

     

       244
       244
       +
           text_body: Email_body_part.t list option;

     

       245
       245
       +
           html_body: Email_body_part.t list option;

     

       246
       246
       +
           attachments: Email_body_part.t list option;

     

       247
       247
       +
         }

     

       248
       248
       +
         

     

       249
       249
       +
         let id t = t.id

     

       250
       250
       +
         let blob_id t = t.blob_id

     

       251
       251
       +
         let thread_id t = t.thread_id

     

       252
       252
       +
         let mailbox_ids t = t.mailbox_ids

     

       253
       253
       +
         let keywords t = t.keywords

     

       254
       254
       +
         let size t = t.size

     

       255
       255
       +
         let received_at t = t.received_at

     

       256
       256
       +
         let subject t = t.subject

     

       257
       257
       +
         let preview t = t.preview

     

       258
       258
       +
         let from t = t.from

     

       259
       259
       +
         let to_ t = t.to_

     

       260
       260
       +
         let cc t = t.cc

     

       261
       261
       +
         let message_id t = t.message_id

     

       262
       262
       +
         let has_attachment t = t.has_attachment

     

       263
       263
       +
         let text_body t = t.text_body

     

       264
       264
       +
         let html_body t = t.html_body

     

       265
       265
       +
         let attachments t = t.attachments

     

       266
       266
       +
         

     

       267
       267
       +
         let create ?id ?blob_id ?thread_id ?mailbox_ids ?keywords ?size

     

       268
       268
       +
             ?received_at ?subject ?preview ?from ?to_ ?cc ?message_id

     

       269
       269
       +
             ?has_attachment ?text_body ?html_body ?attachments () =

     

       270
       270
       +
           { id; blob_id; thread_id; mailbox_ids; keywords; size;

     

       271
       271
       +
             received_at; subject; preview; from; to_; cc; message_id;

     

       272
       272
       +
             has_attachment; text_body; html_body; attachments }

     

       273
       273
       +
           

     

       274
       274
       +
         let make_patch ?add_keywords ?remove_keywords ?add_mailboxes ?remove_mailboxes () =

     

       275
       275
       +
           let patch = [] in

     

       276
       276
       +
           let patch = match add_keywords with

     

       277
       277
       +
             | Some kw -> 

     

       278
       278
       +
                 ("keywords/", `Assoc (List.map (fun k -> 

     

       279
       279
       +
                   (Keywords.to_string k, `Bool true)

     

       280
       280
       +
                 ) kw)) :: patch

     

       281
       281
       +
             | None -> patch

     

       282
       282
       +
           in

     

       283
       283
       +
           let patch = match remove_keywords with

     

       284
       284
       +
             | Some kw -> 

     

       285
       285
       +
                 List.fold_left (fun p k -> 

     

       286
       286
       +
                   ("keywords/" ^ Keywords.to_string k, `Null) :: p

     

       287
       287
       +
                 ) patch kw

     

       288
       288
       +
             | None -> patch

     

       289
       289
       +
           in

     

       290
       290
       +
           let patch = match add_mailboxes with

     

       291
       291
       +
             | Some mboxes -> 

     

       292
       292
       +
                 List.fold_left (fun p mbx -> 

     

       293
       293
       +
                   ("mailboxIds/" ^ mbx, `Bool true) :: p

     

       294
       294
       +
                 ) patch mboxes

     

       295
       295
       +
             | None -> patch

     

       296
       296
       +
           in

     

       297
       297
       +
           let patch = match remove_mailboxes with

     

       298
       298
       +
             | Some mboxes -> 

     

       299
       299
       +
                 List.fold_left (fun p mbx -> 

     

       300
       300
       +
                   ("mailboxIds/" ^ mbx, `Null) :: p

     

       301
       301
       +
                 ) patch mboxes

     

       302
       302
       +
             | None -> patch

     

       303
       303
       +
           in

     

       304
       304
       +
           patch

     

       305
       305
       +
         

     

       306
       306
       +
         let get_id t =

     

       307
       307
       +
           match t.id with

     

       308
       308
       +
           | Some id -> Ok id

     

       309
       309
       +
           | None -> Error "Email missing ID"

     

       310
       310
       +
         

     

       311
       311
       +
         let take_id t =

     

       312
       312
       +
           match t.id with

     

       313
       313
       +
           | Some id -> id

     

       314
       314
       +
           | None -> failwith "Email missing ID"

     

       315
       315
       +
       end

     

       316
       316
       +
       

     

       317
       317
       +
       (* Email import options. *)

     

       318
       318
       +
       type email_import_options = {

     

       319
       319
       +
         import_to_mailboxes : id list;

     

       320
       320
       +
         import_keywords : Keywords.t option;

     

       321
       321
       +
         import_received_at : date option;

     

       322
       322
       +
       }

     

       323
       323
       +
       

     

       324
       324
       +
       (* Email copy options. *)

     

       325
       325
       +
       type email_copy_options = {

     

       326
       326
       +
         copy_to_account_id : id;

     

       327
       327
       +
         copy_to_mailboxes : id list;

     

       328
       328
       +
         copy_on_success_destroy_original : bool option;

     

       329
       329
       +
       }

     

       330
       330
       +
       

     

       331
       331
       +
       (* Convert a property variant to its string representation *)

     

       332
       332
       +
       let email_property_to_string = function

     

       333
       333
       +
         | Id -> "id"

     

       334
       334
       +
         | BlobId -> "blobId"

     

       335
       335
       +
         | ThreadId -> "threadId"

     

       336
       336
       +
         | MailboxIds -> "mailboxIds"

     

       337
       337
       +
         | Keywords -> "keywords"

     

       338
       338
       +
         | Size -> "size"

     

       339
       339
       +
         | ReceivedAt -> "receivedAt"

     

       340
       340
       +
         | MessageId -> "messageId"

     

       341
       341
       +
         | InReplyTo -> "inReplyTo"

     

       342
       342
       +
         | References -> "references"

     

       343
       343
       +
         | Sender -> "sender"

     

       344
       344
       +
         | From -> "from"

     

       345
       345
       +
         | To -> "to"

     

       346
       346
       +
         | Cc -> "cc"

     

       347
       347
       +
         | Bcc -> "bcc"

     

       348
       348
       +
         | ReplyTo -> "replyTo"

     

       349
       349
       +
         | Subject -> "subject"

     

       350
       350
       +
         | SentAt -> "sentAt"

     

       351
       351
       +
         | HasAttachment -> "hasAttachment"

     

       352
       352
       +
         | Preview -> "preview"

     

       353
       353
       +
         | BodyStructure -> "bodyStructure"

     

       354
       354
       +
         | BodyValues -> "bodyValues"

     

       355
       355
       +
         | TextBody -> "textBody"

     

       356
       356
       +
         | HtmlBody -> "htmlBody"

     

       357
       357
       +
         | Attachments -> "attachments"

     

       358
       358
       +
         | Header h -> "header:" ^ h

     

       359
       359
       +
         | Other s -> s

     

       360
       360
       +
       

     

       361
       361
       +
       (* Parse a string into a property variant *)

     

       362
       362
       +
       let string_to_email_property s =

     

       363
       363
       +
         match s with

     

       364
       364
       +
         | "id" -> Id

     

       365
       365
       +
         | "blobId" -> BlobId

     

       366
       366
       +
         | "threadId" -> ThreadId

     

       367
       367
       +
         | "mailboxIds" -> MailboxIds

     

       368
       368
       +
         | "keywords" -> Keywords

     

       369
       369
       +
         | "size" -> Size

     

       370
       370
       +
         | "receivedAt" -> ReceivedAt

     

       371
       371
       +
         | "messageId" -> MessageId

     

       372
       372
       +
         | "inReplyTo" -> InReplyTo

     

       373
       373
       +
         | "references" -> References

     

       374
       374
       +
         | "sender" -> Sender

     

       375
       375
       +
         | "from" -> From

     

       376
       376
       +
         | "to" -> To

     

       377
       377
       +
         | "cc" -> Cc

     

       378
       378
       +
         | "bcc" -> Bcc

     

       379
       379
       +
         | "replyTo" -> ReplyTo

     

       380
       380
       +
         | "subject" -> Subject

     

       381
       381
       +
         | "sentAt" -> SentAt

     

       382
       382
       +
         | "hasAttachment" -> HasAttachment

     

       383
       383
       +
         | "preview" -> Preview

     

       384
       384
       +
         | "bodyStructure" -> BodyStructure

     

       385
       385
       +
         | "bodyValues" -> BodyValues

     

       386
       386
       +
         | "textBody" -> TextBody

     

       387
       387
       +
         | "htmlBody" -> HtmlBody

     

       388
       388
       +
         | "attachments" -> Attachments

     

       389
       389
       +
         | s when String.length s > 7 && String.sub s 0 7 = "header:" ->

     

       390
       390
       +
             Header (String.sub s 7 (String.length s - 7))

     

       391
       391
       +
         | s -> Other s

     

       392
       392
       +
       

     

       393
       393
       +
       (* Get a list of common properties useful for displaying email lists *)

     

       394
       394
       +
       let common_email_properties = [

     

       395
       395
       +
         Id; ThreadId; MailboxIds; Keywords; Size; ReceivedAt;

     

       396
       396
       +
         From; Subject; Preview; HasAttachment; SentAt;

     

       397
       397
       +
       ]

     

       398
       398
       +
       

     

       399
       399
       +
       (* Get a list of common properties for detailed email view *)

     

       400
       400
       +
       let detailed_email_properties = [

     

       401
       401
       +
         Id; ThreadId; MailboxIds; Keywords; Size; ReceivedAt;

     

       402
       402
       +
         MessageId; InReplyTo; References; Sender; From; To; Cc;

     

       403
       403
       +
         ReplyTo; Subject; SentAt; HasAttachment; Preview;

     

       404
       404
       +
         TextBody; HtmlBody; Attachments;

     

       405
       405
       +
       ]

+368

jmap-email/jmap_email_types.mli

···

       1
       1
       +
       (** Common types for JMAP Mail (RFC 8621). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       

     

       5
       5
       +
       (** Represents an email address with an optional name.

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3 *)

     

       7
       7
       +
       module Email_address : sig

     

       8
       8
       +
         type t

     

       9
       9
       +
       

     

       10
       10
       +
         (** Get the display name for the address (if any) *)

     

       11
       11
       +
         val name : t -> string option

     

       12
       12
       +
         

     

       13
       13
       +
         (** Get the email address *)

     

       14
       14
       +
         val email : t -> string

     

       15
       15
       +
         

     

       16
       16
       +
         (** Create a new email address *)

     

       17
       17
       +
         val v : 

     

       18
       18
       +
           ?name:string -> 

     

       19
       19
       +
           email:string -> 

     

       20
       20
       +
           unit -> t

     

       21
       21
       +
       end

     

       22
       22
       +
       

     

       23
       23
       +
       (** Represents a group of email addresses.

     

       24
       24
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4 *)

     

       25
       25
       +
       module Email_address_group : sig

     

       26
       26
       +
         type t

     

       27
       27
       +
         

     

       28
       28
       +
         (** Get the name of the group (if any) *)

     

       29
       29
       +
         val name : t -> string option

     

       30
       30
       +
         

     

       31
       31
       +
         (** Get the list of addresses in the group *)

     

       32
       32
       +
         val addresses : t -> Email_address.t list

     

       33
       33
       +
         

     

       34
       34
       +
         (** Create a new address group *)

     

       35
       35
       +
         val v : 

     

       36
       36
       +
           ?name:string -> 

     

       37
       37
       +
           addresses:Email_address.t list -> 

     

       38
       38
       +
           unit -> t

     

       39
       39
       +
       end

     

       40
       40
       +
       

     

       41
       41
       +
       (** Represents a header field (name and raw value).

     

       42
       42
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3 *)

     

       43
       43
       +
       module Email_header : sig

     

       44
       44
       +
         type t

     

       45
       45
       +
         

     

       46
       46
       +
         (** Get the header field name *)

     

       47
       47
       +
         val name : t -> string

     

       48
       48
       +
         

     

       49
       49
       +
         (** Get the raw header field value *)

     

       50
       50
       +
         val value : t -> string

     

       51
       51
       +
         

     

       52
       52
       +
         (** Create a new header field *)

     

       53
       53
       +
         val v : 

     

       54
       54
       +
           name:string -> 

     

       55
       55
       +
           value:string -> 

     

       56
       56
       +
           unit -> t

     

       57
       57
       +
       end

     

       58
       58
       +
       

     

       59
       59
       +
       (** Represents a body part within an Email's MIME structure.

     

       60
       60
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)

     

       61
       61
       +
       module Email_body_part : sig

     

       62
       62
       +
         type t

     

       63
       63
       +
         

     

       64
       64
       +
         (** Get the part ID (null only for multipart types) *)

     

       65
       65
       +
         val id : t -> string option

     

       66
       66
       +
         

     

       67
       67
       +
         (** Get the blob ID (null only for multipart types) *)

     

       68
       68
       +
         val blob_id : t -> id option

     

       69
       69
       +
         

     

       70
       70
       +
         (** Get the size of the part in bytes *)

     

       71
       71
       +
         val size : t -> uint

     

       72
       72
       +
         

     

       73
       73
       +
         (** Get the list of headers for this part *)

     

       74
       74
       +
         val headers : t -> Email_header.t list

     

       75
       75
       +
         

     

       76
       76
       +
         (** Get the filename (if any) *)

     

       77
       77
       +
         val name : t -> string option

     

       78
       78
       +
         

     

       79
       79
       +
         (** Get the MIME type *)

     

       80
       80
       +
         val mime_type : t -> string

     

       81
       81
       +
         

     

       82
       82
       +
         (** Get the charset (if any) *)

     

       83
       83
       +
         val charset : t -> string option

     

       84
       84
       +
         

     

       85
       85
       +
         (** Get the content disposition (if any) *)

     

       86
       86
       +
         val disposition : t -> string option

     

       87
       87
       +
         

     

       88
       88
       +
         (** Get the content ID (if any) *)

     

       89
       89
       +
         val cid : t -> string option

     

       90
       90
       +
         

     

       91
       91
       +
         (** Get the list of languages (if any) *)

     

       92
       92
       +
         val language : t -> string list option

     

       93
       93
       +
         

     

       94
       94
       +
         (** Get the content location (if any) *)

     

       95
       95
       +
         val location : t -> string option

     

       96
       96
       +
         

     

       97
       97
       +
         (** Get the sub-parts (only for multipart types) *)

     

       98
       98
       +
         val sub_parts : t -> t list option

     

       99
       99
       +
         

     

       100
       100
       +
         (** Get any other requested headers (header properties) *)

     

       101
       101
       +
         val other_headers : t -> Yojson.Safe.t string_map

     

       102
       102
       +
         

     

       103
       103
       +
         (** Create a new body part *)

     

       104
       104
       +
         val v :

     

       105
       105
       +
           ?id:string ->

     

       106
       106
       +
           ?blob_id:id ->

     

       107
       107
       +
           size:uint ->

     

       108
       108
       +
           headers:Email_header.t list ->

     

       109
       109
       +
           ?name:string ->

     

       110
       110
       +
           mime_type:string ->

     

       111
       111
       +
           ?charset:string ->

     

       112
       112
       +
           ?disposition:string ->

     

       113
       113
       +
           ?cid:string ->

     

       114
       114
       +
           ?language:string list ->

     

       115
       115
       +
           ?location:string ->

     

       116
       116
       +
           ?sub_parts:t list ->

     

       117
       117
       +
           ?other_headers:Yojson.Safe.t string_map ->

     

       118
       118
       +
           unit -> t

     

       119
       119
       +
       end

     

       120
       120
       +
       

     

       121
       121
       +
       (** Represents the decoded value of a text body part.

     

       122
       122
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)

     

       123
       123
       +
       module Email_body_value : sig

     

       124
       124
       +
         type t 

     

       125
       125
       +
         

     

       126
       126
       +
         (** Get the decoded text content *)

     

       127
       127
       +
         val value : t -> string

     

       128
       128
       +
         

     

       129
       129
       +
         (** Check if there was an encoding problem *)

     

       130
       130
       +
         val has_encoding_problem : t -> bool

     

       131
       131
       +
         

     

       132
       132
       +
         (** Check if the content was truncated *)

     

       133
       133
       +
         val is_truncated : t -> bool

     

       134
       134
       +
         

     

       135
       135
       +
         (** Create a new body value *)

     

       136
       136
       +
         val v :

     

       137
       137
       +
           value:string ->

     

       138
       138
       +
           ?encoding_problem:bool ->

     

       139
       139
       +
           ?truncated:bool ->

     

       140
       140
       +
           unit -> t

     

       141
       141
       +
       end

     

       142
       142
       +
       

     

       143
       143
       +
       (** Type to represent email message flags/keywords.

     

       144
       144
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)

     

       145
       145
       +
       module Keywords : sig

     

       146
       146
       +
         (** Represents different types of JMAP keywords *)

     

       147
       147
       +
         type keyword =

     

       148
       148
       +
           | Draft      (** "$draft": The Email is a draft the user is composing *)

     

       149
       149
       +
           | Seen       (** "$seen": The Email has been read *)

     

       150
       150
       +
           | Flagged    (** "$flagged": The Email has been flagged for urgent/special attention *)

     

       151
       151
       +
           | Answered   (** "$answered": The Email has been replied to *)

     

       152
       152
       +
           

     

       153
       153
       +
           (* Common extension keywords from RFC 5788 *)

     

       154
       154
       +
           | Forwarded  (** "$forwarded": The Email has been forwarded *)

     

       155
       155
       +
           | Phishing   (** "$phishing": The Email is likely to be phishing *)

     

       156
       156
       +
           | Junk       (** "$junk": The Email is spam/junk *)

     

       157
       157
       +
           | NotJunk    (** "$notjunk": The Email is explicitly marked as not spam/junk *)

     

       158
       158
       +
           | Custom of string  (** Arbitrary user-defined keyword *)

     

       159
       159
       +
       

     

       160
       160
       +
         (** A set of keywords applied to an email *)

     

       161
       161
       +
         type t = keyword list

     

       162
       162
       +
       

     

       163
       163
       +
         (** Check if an email has the draft flag *)

     

       164
       164
       +
         val is_draft : t -> bool

     

       165
       165
       +
         

     

       166
       166
       +
         (** Check if an email has been read *)

     

       167
       167
       +
         val is_seen : t -> bool

     

       168
       168
       +
         

     

       169
       169
       +
         (** Check if an email has neither been read nor is a draft *)

     

       170
       170
       +
         val is_unread : t -> bool

     

       171
       171
       +
         

     

       172
       172
       +
         (** Check if an email has been flagged *)

     

       173
       173
       +
         val is_flagged : t -> bool

     

       174
       174
       +
         

     

       175
       175
       +
         (** Check if an email has been replied to *)

     

       176
       176
       +
         val is_answered : t -> bool

     

       177
       177
       +
         

     

       178
       178
       +
         (** Check if an email has been forwarded *)

     

       179
       179
       +
         val is_forwarded : t -> bool

     

       180
       180
       +
         

     

       181
       181
       +
         (** Check if an email is marked as likely phishing *)

     

       182
       182
       +
         val is_phishing : t -> bool

     

       183
       183
       +
         

     

       184
       184
       +
         (** Check if an email is marked as junk/spam *)

     

       185
       185
       +
         val is_junk : t -> bool

     

       186
       186
       +
         

     

       187
       187
       +
         (** Check if an email is explicitly marked as not junk/spam *)

     

       188
       188
       +
         val is_not_junk : t -> bool

     

       189
       189
       +
         

     

       190
       190
       +
         (** Check if a specific custom keyword is set *)

     

       191
       191
       +
         val has_keyword : t -> string -> bool

     

       192
       192
       +
         

     

       193
       193
       +
         (** Get a list of all custom keywords (excluding system keywords) *)

     

       194
       194
       +
         val custom_keywords : t -> string list

     

       195
       195
       +
         

     

       196
       196
       +
         (** Add a keyword to the set *)

     

       197
       197
       +
         val add : t -> keyword -> t

     

       198
       198
       +
         

     

       199
       199
       +
         (** Remove a keyword from the set *)

     

       200
       200
       +
         val remove : t -> keyword -> t

     

       201
       201
       +
         

     

       202
       202
       +
         (** Create an empty keyword set *)

     

       203
       203
       +
         val empty : unit -> t

     

       204
       204
       +
         

     

       205
       205
       +
         (** Create a new keyword set with the specified keywords *)

     

       206
       206
       +
         val of_list : keyword list -> t

     

       207
       207
       +
         

     

       208
       208
       +
         (** Get the string representation of a keyword as used in the JMAP protocol *)

     

       209
       209
       +
         val to_string : keyword -> string

     

       210
       210
       +
         

     

       211
       211
       +
         (** Parse a string into a keyword *)

     

       212
       212
       +
         val of_string : string -> keyword

     

       213
       213
       +
         

     

       214
       214
       +
         (** Convert keyword set to string map representation as used in JMAP *)

     

       215
       215
       +
         val to_map : t -> bool string_map

     

       216
       216
       +
       end

     

       217
       217
       +
       

     

       218
       218
       +
       (** Email properties enum.

     

       219
       219
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)

     

       220
       220
       +
       type email_property =

     

       221
       221
       +
         | Id               (** The id of the email *)

     

       222
       222
       +
         | BlobId           (** The id of the blob containing the raw message *)

     

       223
       223
       +
         | ThreadId         (** The id of the thread this email belongs to *)

     

       224
       224
       +
         | MailboxIds       (** The mailboxes this email belongs to *)

     

       225
       225
       +
         | Keywords         (** The keywords/flags for this email *)

     

       226
       226
       +
         | Size             (** Size of the message in bytes *)

     

       227
       227
       +
         | ReceivedAt       (** When the message was received by the server *)

     

       228
       228
       +
         | MessageId        (** Value of the Message-ID header *)

     

       229
       229
       +
         | InReplyTo        (** Value of the In-Reply-To header *)

     

       230
       230
       +
         | References       (** Value of the References header *)

     

       231
       231
       +
         | Sender           (** Value of the Sender header *)

     

       232
       232
       +
         | From             (** Value of the From header *)

     

       233
       233
       +
         | To               (** Value of the To header *)

     

       234
       234
       +
         | Cc               (** Value of the Cc header *)

     

       235
       235
       +
         | Bcc              (** Value of the Bcc header *)

     

       236
       236
       +
         | ReplyTo          (** Value of the Reply-To header *)

     

       237
       237
       +
         | Subject          (** Value of the Subject header *)

     

       238
       238
       +
         | SentAt           (** Value of the Date header *)

     

       239
       239
       +
         | HasAttachment    (** Whether the email has attachments *)

     

       240
       240
       +
         | Preview          (** Preview text of the email *)

     

       241
       241
       +
         | BodyStructure    (** MIME structure of the email *)

     

       242
       242
       +
         | BodyValues       (** Decoded body part values *)

     

       243
       243
       +
         | TextBody         (** Text body parts *)

     

       244
       244
       +
         | HtmlBody         (** HTML body parts *)

     

       245
       245
       +
         | Attachments      (** Attachments *)

     

       246
       246
       +
         | Header of string (** Specific header *)

     

       247
       247
       +
         | Other of string  (** Extension property *)

     

       248
       248
       +
       

     

       249
       249
       +
       (** Represents an Email object.

     

       250
       250
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)

     

       251
       251
       +
       module Email : sig

     

       252
       252
       +
         (** Email type *)

     

       253
       253
       +
         type t

     

       254
       254
       +
         

     

       255
       255
       +
         (** ID of the email *)

     

       256
       256
       +
         val id : t -> id option

     

       257
       257
       +
         

     

       258
       258
       +
         (** ID of the blob containing the raw message *)

     

       259
       259
       +
         val blob_id : t -> id option

     

       260
       260
       +
         

     

       261
       261
       +
         (** ID of the thread this email belongs to *)

     

       262
       262
       +
         val thread_id : t -> id option

     

       263
       263
       +
         

     

       264
       264
       +
         (** The set of mailbox IDs this email belongs to *)

     

       265
       265
       +
         val mailbox_ids : t -> bool id_map option

     

       266
       266
       +
         

     

       267
       267
       +
         (** The set of keywords/flags for this email *)

     

       268
       268
       +
         val keywords : t -> Keywords.t option

     

       269
       269
       +
         

     

       270
       270
       +
         (** Size of the message in bytes *)

     

       271
       271
       +
         val size : t -> uint option

     

       272
       272
       +
         

     

       273
       273
       +
         (** When the message was received by the server *)

     

       274
       274
       +
         val received_at : t -> date option

     

       275
       275
       +
         

     

       276
       276
       +
         (** Subject of the email (if requested) *)

     

       277
       277
       +
         val subject : t -> string option

     

       278
       278
       +
         

     

       279
       279
       +
         (** Preview text of the email (if requested) *)

     

       280
       280
       +
         val preview : t -> string option

     

       281
       281
       +
         

     

       282
       282
       +
         (** From addresses (if requested) *)

     

       283
       283
       +
         val from : t -> Email_address.t list option

     

       284
       284
       +
         

     

       285
       285
       +
         (** To addresses (if requested) *)

     

       286
       286
       +
         val to_ : t -> Email_address.t list option

     

       287
       287
       +
         

     

       288
       288
       +
         (** CC addresses (if requested) *)

     

       289
       289
       +
         val cc : t -> Email_address.t list option

     

       290
       290
       +
         

     

       291
       291
       +
         (** Message ID values (if requested) *)

     

       292
       292
       +
         val message_id : t -> string list option

     

       293
       293
       +
         

     

       294
       294
       +
         (** Get whether the email has attachments (if requested) *)

     

       295
       295
       +
         val has_attachment : t -> bool option

     

       296
       296
       +
         

     

       297
       297
       +
         (** Get text body parts (if requested) *)

     

       298
       298
       +
         val text_body : t -> Email_body_part.t list option

     

       299
       299
       +
         

     

       300
       300
       +
         (** Get HTML body parts (if requested) *)

     

       301
       301
       +
         val html_body : t -> Email_body_part.t list option

     

       302
       302
       +
         

     

       303
       303
       +
         (** Get attachments (if requested) *)

     

       304
       304
       +
         val attachments : t -> Email_body_part.t list option

     

       305
       305
       +
         

     

       306
       306
       +
         (** Create a new Email object from a server response or for a new email *)

     

       307
       307
       +
         val create :

     

       308
       308
       +
           ?id:id ->

     

       309
       309
       +
           ?blob_id:id ->

     

       310
       310
       +
           ?thread_id:id ->

     

       311
       311
       +
           ?mailbox_ids:bool id_map ->

     

       312
       312
       +
           ?keywords:Keywords.t ->

     

       313
       313
       +
           ?size:uint ->

     

       314
       314
       +
           ?received_at:date ->

     

       315
       315
       +
           ?subject:string ->

     

       316
       316
       +
           ?preview:string ->

     

       317
       317
       +
           ?from:Email_address.t list ->

     

       318
       318
       +
           ?to_:Email_address.t list ->

     

       319
       319
       +
           ?cc:Email_address.t list ->

     

       320
       320
       +
           ?message_id:string list ->

     

       321
       321
       +
           ?has_attachment:bool ->

     

       322
       322
       +
           ?text_body:Email_body_part.t list ->

     

       323
       323
       +
           ?html_body:Email_body_part.t list ->

     

       324
       324
       +
           ?attachments:Email_body_part.t list ->

     

       325
       325
       +
           unit -> t

     

       326
       326
       +
           

     

       327
       327
       +
         (** Create a patch object for updating email properties *)

     

       328
       328
       +
         val make_patch :

     

       329
       329
       +
           ?add_keywords:Keywords.t ->

     

       330
       330
       +
           ?remove_keywords:Keywords.t ->

     

       331
       331
       +
           ?add_mailboxes:id list ->

     

       332
       332
       +
           ?remove_mailboxes:id list ->

     

       333
       333
       +
           unit -> Jmap.Methods.patch_object

     

       334
       334
       +
         

     

       335
       335
       +
         (** Extract the ID from an email, returning a Result *)

     

       336
       336
       +
         val get_id : t -> (id, string) result

     

       337
       337
       +
         

     

       338
       338
       +
         (** Take the ID from an email (fails with an exception if not present) *)

     

       339
       339
       +
         val take_id : t -> id

     

       340
       340
       +
       end

     

       341
       341
       +
       

     

       342
       342
       +
       (** Email import options.

     

       343
       343
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.5> RFC 8621, Section 4.5 *)

     

       344
       344
       +
       type email_import_options = {

     

       345
       345
       +
         import_to_mailboxes : id list;

     

       346
       346
       +
         import_keywords : Keywords.t option;

     

       347
       347
       +
         import_received_at : date option;

     

       348
       348
       +
       }

     

       349
       349
       +
       

     

       350
       350
       +
       (** Email copy options.

     

       351
       351
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621, Section 4.6 *)

     

       352
       352
       +
       type email_copy_options = {

     

       353
       353
       +
         copy_to_account_id : id;

     

       354
       354
       +
         copy_to_mailboxes : id list;

     

       355
       355
       +
         copy_on_success_destroy_original : bool option;

     

       356
       356
       +
       }

     

       357
       357
       +
       

     

       358
       358
       +
       (** Convert a property variant to its string representation *)

     

       359
       359
       +
       val email_property_to_string : email_property -> string

     

       360
       360
       +
       

     

       361
       361
       +
       (** Parse a string into a property variant *)

     

       362
       362
       +
       val string_to_email_property : string -> email_property

     

       363
       363
       +
       

     

       364
       364
       +
       (** Get a list of common properties useful for displaying email lists *)

     

       365
       365
       +
       val common_email_properties : email_property list

     

       366
       366
       +
       

     

       367
       367
       +
       (** Get a list of common properties for detailed email view *)

     

       368
       368
       +
       val detailed_email_properties : email_property list

+130

jmap-email/jmap_identity.ml

···

       1
       1
       +
       (* JMAP Identity. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       open Jmap.Methods

     

       5
       5
       +
       

     

       6
       6
       +
       (* Identity object. *)

     

       7
       7
       +
       type t = {

     

       8
       8
       +
         id_value: id;

     

       9
       9
       +
         name_value: string;

     

       10
       10
       +
         email_value: string;

     

       11
       11
       +
         reply_to_value: Jmap_email_types.Email_address.t list option;

     

       12
       12
       +
         bcc_value: Jmap_email_types.Email_address.t list option;

     

       13
       13
       +
         text_signature_value: string;

     

       14
       14
       +
         html_signature_value: string;

     

       15
       15
       +
         may_delete_value: bool;

     

       16
       16
       +
       }

     

       17
       17
       +
       

     

       18
       18
       +
       (* Get the identity ID (immutable, server-set) *)

     

       19
       19
       +
       let id t = t.id_value

     

       20
       20
       +
       

     

       21
       21
       +
       (* Get the display name (defaults to "") *)

     

       22
       22
       +
       let name t = t.name_value

     

       23
       23
       +
       

     

       24
       24
       +
       (* Get the email address (immutable) *)

     

       25
       25
       +
       let email t = t.email_value

     

       26
       26
       +
       

     

       27
       27
       +
       (* Get the reply-to addresses (if any) *)

     

       28
       28
       +
       let reply_to t = t.reply_to_value

     

       29
       29
       +
       

     

       30
       30
       +
       (* Get the bcc addresses (if any) *)

     

       31
       31
       +
       let bcc t = t.bcc_value

     

       32
       32
       +
       

     

       33
       33
       +
       (* Get the plain text signature (defaults to "") *)

     

       34
       34
       +
       let text_signature t = t.text_signature_value

     

       35
       35
       +
       

     

       36
       36
       +
       (* Get the HTML signature (defaults to "") *)

     

       37
       37
       +
       let html_signature t = t.html_signature_value

     

       38
       38
       +
       

     

       39
       39
       +
       (* Check if this identity may be deleted (server-set) *)

     

       40
       40
       +
       let may_delete t = t.may_delete_value

     

       41
       41
       +
       

     

       42
       42
       +
       (* Create a new identity object *)

     

       43
       43
       +
       let v ~id ?(name="") ~email ?reply_to ?bcc ?(text_signature="") ?(html_signature="") ~may_delete () = {

     

       44
       44
       +
         id_value = id;

     

       45
       45
       +
         name_value = name;

     

       46
       46
       +
         email_value = email;

     

       47
       47
       +
         reply_to_value = reply_to;

     

       48
       48
       +
         bcc_value = bcc;

     

       49
       49
       +
         text_signature_value = text_signature;

     

       50
       50
       +
         html_signature_value = html_signature;

     

       51
       51
       +
         may_delete_value = may_delete;

     

       52
       52
       +
       }

     

       53
       53
       +
       

     

       54
       54
       +
       (* Types and functions for identity creation and updates *)

     

       55
       55
       +
       module Create = struct

     

       56
       56
       +
         type t = {

     

       57
       57
       +
           name_value: string option;

     

       58
       58
       +
           email_value: string;

     

       59
       59
       +
           reply_to_value: Jmap_email_types.Email_address.t list option;

     

       60
       60
       +
           bcc_value: Jmap_email_types.Email_address.t list option;

     

       61
       61
       +
           text_signature_value: string option;

     

       62
       62
       +
           html_signature_value: string option;

     

       63
       63
       +
         }

     

       64
       64
       +
         

     

       65
       65
       +
         (* Get the name (if specified) *)

     

       66
       66
       +
         let name t = t.name_value

     

       67
       67
       +
         

     

       68
       68
       +
         (* Get the email address *)

     

       69
       69
       +
         let email t = t.email_value

     

       70
       70
       +
         

     

       71
       71
       +
         (* Get the reply-to addresses (if any) *)

     

       72
       72
       +
         let reply_to t = t.reply_to_value

     

       73
       73
       +
         

     

       74
       74
       +
         (* Get the bcc addresses (if any) *)

     

       75
       75
       +
         let bcc t = t.bcc_value

     

       76
       76
       +
         

     

       77
       77
       +
         (* Get the plain text signature (if specified) *)

     

       78
       78
       +
         let text_signature t = t.text_signature_value

     

       79
       79
       +
         

     

       80
       80
       +
         (* Get the HTML signature (if specified) *)

     

       81
       81
       +
         let html_signature t = t.html_signature_value

     

       82
       82
       +
         

     

       83
       83
       +
         (* Create a new identity creation object *)

     

       84
       84
       +
         let v ?name ~email ?reply_to ?bcc ?text_signature ?html_signature () = {

     

       85
       85
       +
           name_value = name;

     

       86
       86
       +
           email_value = email;

     

       87
       87
       +
           reply_to_value = reply_to;

     

       88
       88
       +
           bcc_value = bcc;

     

       89
       89
       +
           text_signature_value = text_signature;

     

       90
       90
       +
           html_signature_value = html_signature;

     

       91
       91
       +
         }

     

       92
       92
       +
         

     

       93
       93
       +
         (* Server response with info about the created identity *)

     

       94
       94
       +
         module Response = struct

     

       95
       95
       +
           type t = {

     

       96
       96
       +
             id_value: id;

     

       97
       97
       +
             may_delete_value: bool;

     

       98
       98
       +
           }

     

       99
       99
       +
           

     

       100
       100
       +
           (* Get the server-assigned ID for the created identity *)

     

       101
       101
       +
           let id t = t.id_value

     

       102
       102
       +
           

     

       103
       103
       +
           (* Check if this identity may be deleted *)

     

       104
       104
       +
           let may_delete t = t.may_delete_value

     

       105
       105
       +
           

     

       106
       106
       +
           (* Create a new response object *)

     

       107
       107
       +
           let v ~id ~may_delete () = {

     

       108
       108
       +
             id_value = id;

     

       109
       109
       +
             may_delete_value = may_delete;

     

       110
       110
       +
           }

     

       111
       111
       +
         end

     

       112
       112
       +
       end

     

       113
       113
       +
       

     

       114
       114
       +
       (* Identity object for update.

     

       115
       115
       +
          Patch object, specific structure not enforced here. *)

     

       116
       116
       +
       type update = patch_object

     

       117
       117
       +
       

     

       118
       118
       +
       (* Server-set/computed info for updated identity.

     

       119
       119
       +
          Contains only changed server-set props. *)

     

       120
       120
       +
       module Update_response = struct

     

       121
       121
       +
         (* We use the same type as main identity *)

     

       122
       122
       +
         type identity_update = t

     

       123
       123
       +
         type t = identity_update

     

       124
       124
       +
         

     

       125
       125
       +
         (* Convert to a full Identity object (contains only changed server-set props) *)

     

       126
       126
       +
         let to_identity t = (t : t :> t)

     

       127
       127
       +
         

     

       128
       128
       +
         (* Create from a full Identity object *)

     

       129
       129
       +
         let of_identity t = (t : t :> t)

     

       130
       130
       +
       end

+114

jmap-email/jmap_identity.mli

···

       1
       1
       +
       (** JMAP Identity.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Identity object.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)

     

       9
       9
       +
       type t

     

       10
       10
       +
       

     

       11
       11
       +
       (** Get the identity ID (immutable, server-set) *)

     

       12
       12
       +
       val id : t -> id

     

       13
       13
       +
       

     

       14
       14
       +
       (** Get the display name (defaults to "") *)

     

       15
       15
       +
       val name : t -> string

     

       16
       16
       +
       

     

       17
       17
       +
       (** Get the email address (immutable) *)

     

       18
       18
       +
       val email : t -> string

     

       19
       19
       +
       

     

       20
       20
       +
       (** Get the reply-to addresses (if any) *)

     

       21
       21
       +
       val reply_to : t -> Jmap_email_types.Email_address.t list option

     

       22
       22
       +
       

     

       23
       23
       +
       (** Get the bcc addresses (if any) *)

     

       24
       24
       +
       val bcc : t -> Jmap_email_types.Email_address.t list option

     

       25
       25
       +
       

     

       26
       26
       +
       (** Get the plain text signature (defaults to "") *)

     

       27
       27
       +
       val text_signature : t -> string

     

       28
       28
       +
       

     

       29
       29
       +
       (** Get the HTML signature (defaults to "") *)

     

       30
       30
       +
       val html_signature : t -> string

     

       31
       31
       +
       

     

       32
       32
       +
       (** Check if this identity may be deleted (server-set) *)

     

       33
       33
       +
       val may_delete : t -> bool

     

       34
       34
       +
       

     

       35
       35
       +
       (** Create a new identity object *)

     

       36
       36
       +
       val v :

     

       37
       37
       +
         id:id ->

     

       38
       38
       +
         ?name:string ->

     

       39
       39
       +
         email:string ->

     

       40
       40
       +
         ?reply_to:Jmap_email_types.Email_address.t list ->

     

       41
       41
       +
         ?bcc:Jmap_email_types.Email_address.t list ->

     

       42
       42
       +
         ?text_signature:string ->

     

       43
       43
       +
         ?html_signature:string ->

     

       44
       44
       +
         may_delete:bool ->

     

       45
       45
       +
         unit -> t

     

       46
       46
       +
         

     

       47
       47
       +
       (** Types and functions for identity creation and updates *)

     

       48
       48
       +
       module Create : sig

     

       49
       49
       +
         type t

     

       50
       50
       +
         

     

       51
       51
       +
         (** Get the name (if specified) *)

     

       52
       52
       +
         val name : t -> string option

     

       53
       53
       +
         

     

       54
       54
       +
         (** Get the email address *)

     

       55
       55
       +
         val email : t -> string

     

       56
       56
       +
         

     

       57
       57
       +
         (** Get the reply-to addresses (if any) *)

     

       58
       58
       +
         val reply_to : t -> Jmap_email_types.Email_address.t list option

     

       59
       59
       +
         

     

       60
       60
       +
         (** Get the bcc addresses (if any) *)

     

       61
       61
       +
         val bcc : t -> Jmap_email_types.Email_address.t list option

     

       62
       62
       +
         

     

       63
       63
       +
         (** Get the plain text signature (if specified) *)

     

       64
       64
       +
         val text_signature : t -> string option

     

       65
       65
       +
         

     

       66
       66
       +
         (** Get the HTML signature (if specified) *)

     

       67
       67
       +
         val html_signature : t -> string option

     

       68
       68
       +
         

     

       69
       69
       +
         (** Create a new identity creation object *)

     

       70
       70
       +
         val v :

     

       71
       71
       +
           ?name:string ->

     

       72
       72
       +
           email:string ->

     

       73
       73
       +
           ?reply_to:Jmap_email_types.Email_address.t list ->

     

       74
       74
       +
           ?bcc:Jmap_email_types.Email_address.t list ->

     

       75
       75
       +
           ?text_signature:string ->

     

       76
       76
       +
           ?html_signature:string ->

     

       77
       77
       +
           unit -> t

     

       78
       78
       +
           

     

       79
       79
       +
         (** Server response with info about the created identity *)

     

       80
       80
       +
         module Response : sig

     

       81
       81
       +
           type t

     

       82
       82
       +
           

     

       83
       83
       +
           (** Get the server-assigned ID for the created identity *)

     

       84
       84
       +
           val id : t -> id

     

       85
       85
       +
           

     

       86
       86
       +
           (** Check if this identity may be deleted *)

     

       87
       87
       +
           val may_delete : t -> bool

     

       88
       88
       +
           

     

       89
       89
       +
           (** Create a new response object *)

     

       90
       90
       +
           val v :

     

       91
       91
       +
             id:id ->

     

       92
       92
       +
             may_delete:bool ->

     

       93
       93
       +
             unit -> t

     

       94
       94
       +
         end

     

       95
       95
       +
       end

     

       96
       96
       +
       

     

       97
       97
       +
       (** Identity object for update.

     

       98
       98
       +
           Patch object, specific structure not enforced here.

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)

     

       100
       100
       +
       type update = patch_object

     

       101
       101
       +
       

     

       102
       102
       +
       (** Server-set/computed info for updated identity.

     

       103
       103
       +
           Contains only changed server-set props.

     

       104
       104
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)

     

       105
       105
       +
       module Update_response : sig

     

       106
       106
       +
         type t

     

       107
       107
       +
         

     

       108
       108
       +
         (** Convert to a full Identity object (contains only changed server-set props) *)

     

       109
       109
       +
         val to_identity : t -> t

     

       110
       110
       +
         

     

       111
       111
       +
         (** Create from a full Identity object *)

     

       112
       112
       +
         val of_identity : t -> t

     

       113
       113
       +
       end

     

       114
       114
       +

+282

jmap-email/jmap_mailbox.ml

···

       1
       1
       +
       (* JMAP Mailbox. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       open Jmap.Methods

     

       5
       5
       +
       

     

       6
       6
       +
       (* Standard mailbox roles as defined in RFC 8621. *)

     

       7
       7
       +
       type role =

     

       8
       8
       +
         | Inbox     (* Messages in the primary inbox *)

     

       9
       9
       +
         | Archive   (* Archived messages *)

     

       10
       10
       +
         | Drafts    (* Draft messages being composed *)

     

       11
       11
       +
         | Sent      (* Messages that have been sent *)

     

       12
       12
       +
         | Trash     (* Messages that have been deleted *)

     

       13
       13
       +
         | Junk      (* Messages determined to be spam *)

     

       14
       14
       +
         | Important (* Messages deemed important *)

     

       15
       15
       +
         | Other of string (* Custom or non-standard role *)

     

       16
       16
       +
         | None      (* No specific role assigned *)

     

       17
       17
       +
       

     

       18
       18
       +
       (* Mailbox property identifiers. *)

     

       19
       19
       +
       type property =

     

       20
       20
       +
         | Id            (* The id of the mailbox *)

     

       21
       21
       +
         | Name          (* The name of the mailbox *)

     

       22
       22
       +
         | ParentId      (* The id of the parent mailbox *)

     

       23
       23
       +
         | Role          (* The role of the mailbox *)

     

       24
       24
       +
         | SortOrder     (* The sort order of the mailbox *)

     

       25
       25
       +
         | TotalEmails   (* The total number of emails in the mailbox *)

     

       26
       26
       +
         | UnreadEmails  (* The number of unread emails in the mailbox *)

     

       27
       27
       +
         | TotalThreads  (* The total number of threads in the mailbox *)

     

       28
       28
       +
         | UnreadThreads (* The number of unread threads in the mailbox *)

     

       29
       29
       +
         | MyRights      (* The rights the user has for the mailbox *)

     

       30
       30
       +
         | IsSubscribed  (* Whether the mailbox is subscribed to *)

     

       31
       31
       +
         | Other of string (* Any server-specific extension properties *)

     

       32
       32
       +
       

     

       33
       33
       +
       (* Mailbox access rights. *)

     

       34
       34
       +
       type mailbox_rights = {

     

       35
       35
       +
         may_read_items : bool;

     

       36
       36
       +
         may_add_items : bool;

     

       37
       37
       +
         may_remove_items : bool;

     

       38
       38
       +
         may_set_seen : bool;

     

       39
       39
       +
         may_set_keywords : bool;

     

       40
       40
       +
         may_create_child : bool;

     

       41
       41
       +
         may_rename : bool;

     

       42
       42
       +
         may_delete : bool;

     

       43
       43
       +
         may_submit : bool;

     

       44
       44
       +
       }

     

       45
       45
       +
       

     

       46
       46
       +
       (* Mailbox object. *)

     

       47
       47
       +
       type mailbox = {

     

       48
       48
       +
         mailbox_id : id; (* immutable, server-set *)

     

       49
       49
       +
         name : string;

     

       50
       50
       +
         parent_id : id option;

     

       51
       51
       +
         role : role option;

     

       52
       52
       +
         sort_order : uint; (* default: 0 *)

     

       53
       53
       +
         total_emails : uint; (* server-set *)

     

       54
       54
       +
         unread_emails : uint; (* server-set *)

     

       55
       55
       +
         total_threads : uint; (* server-set *)

     

       56
       56
       +
         unread_threads : uint; (* server-set *)

     

       57
       57
       +
         my_rights : mailbox_rights; (* server-set *)

     

       58
       58
       +
         is_subscribed : bool;

     

       59
       59
       +
       }

     

       60
       60
       +
       

     

       61
       61
       +
       (* Mailbox object for creation.

     

       62
       62
       +
          Excludes server-set fields. *)

     

       63
       63
       +
       type mailbox_create = {

     

       64
       64
       +
         mailbox_create_name : string;

     

       65
       65
       +
         mailbox_create_parent_id : id option;

     

       66
       66
       +
         mailbox_create_role : role option;

     

       67
       67
       +
         mailbox_create_sort_order : uint option;

     

       68
       68
       +
         mailbox_create_is_subscribed : bool option;

     

       69
       69
       +
       }

     

       70
       70
       +
       

     

       71
       71
       +
       (* Mailbox object for update.

     

       72
       72
       +
          Patch object, specific structure not enforced here. *)

     

       73
       73
       +
       type mailbox_update = patch_object

     

       74
       74
       +
       

     

       75
       75
       +
       (* Server-set info for created mailbox. *)

     

       76
       76
       +
       type mailbox_created_info = {

     

       77
       77
       +
         mailbox_created_id : id;

     

       78
       78
       +
         mailbox_created_role : role option; (* If default used *)

     

       79
       79
       +
         mailbox_created_sort_order : uint; (* If default used *)

     

       80
       80
       +
         mailbox_created_total_emails : uint;

     

       81
       81
       +
         mailbox_created_unread_emails : uint;

     

       82
       82
       +
         mailbox_created_total_threads : uint;

     

       83
       83
       +
         mailbox_created_unread_threads : uint;

     

       84
       84
       +
         mailbox_created_my_rights : mailbox_rights;

     

       85
       85
       +
         mailbox_created_is_subscribed : bool; (* If default used *)

     

       86
       86
       +
       }

     

       87
       87
       +
       

     

       88
       88
       +
       (* Server-set/computed info for updated mailbox. *)

     

       89
       89
       +
       type mailbox_updated_info = mailbox (* Contains only changed server-set props *)

     

       90
       90
       +
       

     

       91
       91
       +
       (* FilterCondition for Mailbox/query. *)

     

       92
       92
       +
       type mailbox_filter_condition = {

     

       93
       93
       +
         filter_parent_id : id option option; (* Use option option for explicit null *)

     

       94
       94
       +
         filter_name : string option;

     

       95
       95
       +
         filter_role : role option option; (* Use option option for explicit null *)

     

       96
       96
       +
         filter_has_any_role : bool option;

     

       97
       97
       +
         filter_is_subscribed : bool option;

     

       98
       98
       +
       }

     

       99
       99
       +
       

     

       100
       100
       +
       (* Role and Property Conversion Functions *)

     

       101
       101
       +
       

     

       102
       102
       +
       (* Role conversion utilities *)

     

       103
       103
       +
       let role_to_string = function

     

       104
       104
       +
         | Inbox -> "inbox"

     

       105
       105
       +
         | Archive -> "archive" 

     

       106
       106
       +
         | Drafts -> "drafts"

     

       107
       107
       +
         | Sent -> "sent"

     

       108
       108
       +
         | Trash -> "trash"

     

       109
       109
       +
         | Junk -> "junk"

     

       110
       110
       +
         | Important -> "important"

     

       111
       111
       +
         | Other s -> s

     

       112
       112
       +
         | None -> ""

     

       113
       113
       +
       

     

       114
       114
       +
       let string_to_role = function

     

       115
       115
       +
         | "inbox" -> Inbox

     

       116
       116
       +
         | "archive" -> Archive

     

       117
       117
       +
         | "drafts" -> Drafts

     

       118
       118
       +
         | "sent" -> Sent

     

       119
       119
       +
         | "trash" -> Trash

     

       120
       120
       +
         | "junk" -> Junk

     

       121
       121
       +
         | "important" -> Important

     

       122
       122
       +
         | "" -> None

     

       123
       123
       +
         | s -> Other s

     

       124
       124
       +
       

     

       125
       125
       +
       (* Property conversion utilities *)

     

       126
       126
       +
       let property_to_string = function

     

       127
       127
       +
         | Id -> "id"

     

       128
       128
       +
         | Name -> "name"

     

       129
       129
       +
         | ParentId -> "parentId"

     

       130
       130
       +
         | Role -> "role"

     

       131
       131
       +
         | SortOrder -> "sortOrder"

     

       132
       132
       +
         | TotalEmails -> "totalEmails"

     

       133
       133
       +
         | UnreadEmails -> "unreadEmails"

     

       134
       134
       +
         | TotalThreads -> "totalThreads"

     

       135
       135
       +
         | UnreadThreads -> "unreadThreads"

     

       136
       136
       +
         | MyRights -> "myRights"

     

       137
       137
       +
         | IsSubscribed -> "isSubscribed"

     

       138
       138
       +
         | Other s -> s

     

       139
       139
       +
       

     

       140
       140
       +
       let string_to_property = function

     

       141
       141
       +
         | "id" -> Id

     

       142
       142
       +
         | "name" -> Name

     

       143
       143
       +
         | "parentId" -> ParentId

     

       144
       144
       +
         | "role" -> Role

     

       145
       145
       +
         | "sortOrder" -> SortOrder

     

       146
       146
       +
         | "totalEmails" -> TotalEmails

     

       147
       147
       +
         | "unreadEmails" -> UnreadEmails

     

       148
       148
       +
         | "totalThreads" -> TotalThreads

     

       149
       149
       +
         | "unreadThreads" -> UnreadThreads

     

       150
       150
       +
         | "myRights" -> MyRights

     

       151
       151
       +
         | "isSubscribed" -> IsSubscribed

     

       152
       152
       +
         | s -> Other s

     

       153
       153
       +
       

     

       154
       154
       +
       (* Get a list of common properties useful for displaying mailboxes *)

     

       155
       155
       +
       let common_properties = [

     

       156
       156
       +
         Id; Name; ParentId; Role; 

     

       157
       157
       +
         TotalEmails; UnreadEmails; 

     

       158
       158
       +
         IsSubscribed

     

       159
       159
       +
       ]

     

       160
       160
       +
       

     

       161
       161
       +
       (* Get a list of all standard properties *)

     

       162
       162
       +
       let all_properties = [

     

       163
       163
       +
         Id; Name; ParentId; Role; SortOrder;

     

       164
       164
       +
         TotalEmails; UnreadEmails; TotalThreads; UnreadThreads;

     

       165
       165
       +
         MyRights; IsSubscribed

     

       166
       166
       +
       ]

     

       167
       167
       +
       

     

       168
       168
       +
       (* Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)

     

       169
       169
       +
       let is_count_property = function

     

       170
       170
       +
         | TotalEmails | UnreadEmails | TotalThreads | UnreadThreads -> true

     

       171
       171
       +
         | _ -> false

     

       172
       172
       +
       

     

       173
       173
       +
       (* Mailbox Creation and Manipulation *)

     

       174
       174
       +
       

     

       175
       175
       +
       (* Create a set of default rights with all permissions *)

     

       176
       176
       +
       let default_rights () = {

     

       177
       177
       +
         may_read_items = true;

     

       178
       178
       +
         may_add_items = true;

     

       179
       179
       +
         may_remove_items = true;

     

       180
       180
       +
         may_set_seen = true;

     

       181
       181
       +
         may_set_keywords = true;

     

       182
       182
       +
         may_create_child = true;

     

       183
       183
       +
         may_rename = true;

     

       184
       184
       +
         may_delete = true;

     

       185
       185
       +
         may_submit = true;

     

       186
       186
       +
       }

     

       187
       187
       +
       

     

       188
       188
       +
       (* Create a set of read-only rights *)

     

       189
       189
       +
       let readonly_rights () = {

     

       190
       190
       +
         may_read_items = true;

     

       191
       191
       +
         may_add_items = false;

     

       192
       192
       +
         may_remove_items = false;

     

       193
       193
       +
         may_set_seen = false;

     

       194
       194
       +
         may_set_keywords = false;

     

       195
       195
       +
         may_create_child = false;

     

       196
       196
       +
         may_rename = false;

     

       197
       197
       +
         may_delete = false;

     

       198
       198
       +
         may_submit = false;

     

       199
       199
       +
       }

     

       200
       200
       +
       

     

       201
       201
       +
       (* Create a new mailbox object with minimal required fields *)

     

       202
       202
       +
       let create ~name ?parent_id ?role ?sort_order ?is_subscribed () = {

     

       203
       203
       +
         mailbox_create_name = name;

     

       204
       204
       +
         mailbox_create_parent_id = parent_id;

     

       205
       205
       +
         mailbox_create_role = role;

     

       206
       206
       +
         mailbox_create_sort_order = sort_order;

     

       207
       207
       +
         mailbox_create_is_subscribed = is_subscribed;

     

       208
       208
       +
       }

     

       209
       209
       +
       

     

       210
       210
       +
       (* Build a patch object for updating mailbox properties *)

     

       211
       211
       +
       let update ?name ?parent_id ?role ?sort_order ?is_subscribed () =

     

       212
       212
       +
         let patches = [] in

     

       213
       213
       +
         let patches = 

     

       214
       214
       +
           match name with

     

       215
       215
       +
           | Some new_name -> ("name", `String new_name) :: patches

     

       216
       216
       +
           | None -> patches

     

       217
       217
       +
         in

     

       218
       218
       +
         let patches = 

     

       219
       219
       +
           match parent_id with

     

       220
       220
       +
           | Some (Some pid) -> ("parentId", `String pid) :: patches

     

       221
       221
       +
           | Some None -> ("parentId", `Null) :: patches

     

       222
       222
       +
           | None -> patches

     

       223
       223
       +
         in

     

       224
       224
       +
         let patches = 

     

       225
       225
       +
           match role with

     

       226
       226
       +
           | Some (Some r) -> ("role", `String (role_to_string r)) :: patches

     

       227
       227
       +
           | Some None -> ("role", `Null) :: patches

     

       228
       228
       +
           | None -> patches

     

       229
       229
       +
         in

     

       230
       230
       +
         let patches = 

     

       231
       231
       +
           match sort_order with

     

       232
       232
       +
           | Some order -> ("sortOrder", `Int order) :: patches

     

       233
       233
       +
           | None -> patches

     

       234
       234
       +
         in

     

       235
       235
       +
         let patches = 

     

       236
       236
       +
           match is_subscribed with

     

       237
       237
       +
           | Some subscribed -> ("isSubscribed", `Bool subscribed) :: patches

     

       238
       238
       +
           | None -> patches

     

       239
       239
       +
         in

     

       240
       240
       +
         patches

     

       241
       241
       +
       

     

       242
       242
       +
       (* Get the list of standard role names and their string representations *)

     

       243
       243
       +
       let standard_role_names = [

     

       244
       244
       +
         (Inbox, "inbox");

     

       245
       245
       +
         (Archive, "archive");

     

       246
       246
       +
         (Drafts, "drafts");

     

       247
       247
       +
         (Sent, "sent");

     

       248
       248
       +
         (Trash, "trash");

     

       249
       249
       +
         (Junk, "junk");

     

       250
       250
       +
         (Important, "important");

     

       251
       251
       +
         (None, "");

     

       252
       252
       +
       ]

     

       253
       253
       +
       

     

       254
       254
       +
       (* Filter Construction *)

     

       255
       255
       +
       

     

       256
       256
       +
       (* Create a filter to match mailboxes with a specific role *)

     

       257
       257
       +
       let filter_has_role role =

     

       258
       258
       +
         Filter.property_equals "role" (`String (role_to_string role))

     

       259
       259
       +
       

     

       260
       260
       +
       (* Create a filter to match mailboxes with no role *)

     

       261
       261
       +
       let filter_has_no_role () =

     

       262
       262
       +
         Filter.property_equals "role" `Null

     

       263
       263
       +
       

     

       264
       264
       +
       (* Create a filter to match mailboxes that are child of a given parent *)

     

       265
       265
       +
       let filter_has_parent parent_id =

     

       266
       266
       +
         Filter.property_equals "parentId" (`String parent_id)

     

       267
       267
       +
       

     

       268
       268
       +
       (* Create a filter to match mailboxes at the root level (no parent) *)

     

       269
       269
       +
       let filter_is_root () =

     

       270
       270
       +
         Filter.property_equals "parentId" `Null

     

       271
       271
       +
       

     

       272
       272
       +
       (* Create a filter to match subscribed mailboxes *)

     

       273
       273
       +
       let filter_is_subscribed () =

     

       274
       274
       +
         Filter.property_equals "isSubscribed" (`Bool true)

     

       275
       275
       +
       

     

       276
       276
       +
       (* Create a filter to match unsubscribed mailboxes *)

     

       277
       277
       +
       let filter_is_not_subscribed () =

     

       278
       278
       +
         Filter.property_equals "isSubscribed" (`Bool false)

     

       279
       279
       +
       

     

       280
       280
       +
       (* Create a filter to match mailboxes by name (using case-insensitive substring matching) *)

     

       281
       281
       +
       let filter_name_contains name =

     

       282
       282
       +
         Filter.text_contains "name" name

+183

jmap-email/jmap_mailbox.mli

···

       1
       1
       +
       (** JMAP Mailbox.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Standard mailbox roles as defined in RFC 8621.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       9
       9
       +
       type role =

     

       10
       10
       +
         | Inbox     (** Messages in the primary inbox *)

     

       11
       11
       +
         | Archive   (** Archived messages *)

     

       12
       12
       +
         | Drafts    (** Draft messages being composed *)

     

       13
       13
       +
         | Sent      (** Messages that have been sent *)

     

       14
       14
       +
         | Trash     (** Messages that have been deleted *)

     

       15
       15
       +
         | Junk      (** Messages determined to be spam *)

     

       16
       16
       +
         | Important (** Messages deemed important *)

     

       17
       17
       +
         | Other of string (** Custom or non-standard role *)

     

       18
       18
       +
         | None      (** No specific role assigned *)

     

       19
       19
       +
       

     

       20
       20
       +
       (** Mailbox property identifiers.

     

       21
       21
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       22
       22
       +
       type property =

     

       23
       23
       +
         | Id            (** The id of the mailbox *)

     

       24
       24
       +
         | Name          (** The name of the mailbox *)

     

       25
       25
       +
         | ParentId      (** The id of the parent mailbox *)

     

       26
       26
       +
         | Role          (** The role of the mailbox *)

     

       27
       27
       +
         | SortOrder     (** The sort order of the mailbox *)

     

       28
       28
       +
         | TotalEmails   (** The total number of emails in the mailbox *)

     

       29
       29
       +
         | UnreadEmails  (** The number of unread emails in the mailbox *)

     

       30
       30
       +
         | TotalThreads  (** The total number of threads in the mailbox *)

     

       31
       31
       +
         | UnreadThreads (** The number of unread threads in the mailbox *)

     

       32
       32
       +
         | MyRights      (** The rights the user has for the mailbox *)

     

       33
       33
       +
         | IsSubscribed  (** Whether the mailbox is subscribed to *)

     

       34
       34
       +
         | Other of string (** Any server-specific extension properties *)

     

       35
       35
       +
       

     

       36
       36
       +
       (** Mailbox access rights.

     

       37
       37
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       38
       38
       +
       type mailbox_rights = {

     

       39
       39
       +
         may_read_items : bool;

     

       40
       40
       +
         may_add_items : bool;

     

       41
       41
       +
         may_remove_items : bool;

     

       42
       42
       +
         may_set_seen : bool;

     

       43
       43
       +
         may_set_keywords : bool;

     

       44
       44
       +
         may_create_child : bool;

     

       45
       45
       +
         may_rename : bool;

     

       46
       46
       +
         may_delete : bool;

     

       47
       47
       +
         may_submit : bool;

     

       48
       48
       +
       }

     

       49
       49
       +
       

     

       50
       50
       +
       (** Mailbox object.

     

       51
       51
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       52
       52
       +
       type mailbox = {

     

       53
       53
       +
         mailbox_id : id; (** immutable, server-set *)

     

       54
       54
       +
         name : string;

     

       55
       55
       +
         parent_id : id option;

     

       56
       56
       +
         role : role option;

     

       57
       57
       +
         sort_order : uint; (* default: 0 *)

     

       58
       58
       +
         total_emails : uint; (** server-set *)

     

       59
       59
       +
         unread_emails : uint; (** server-set *)

     

       60
       60
       +
         total_threads : uint; (** server-set *)

     

       61
       61
       +
         unread_threads : uint; (** server-set *)

     

       62
       62
       +
         my_rights : mailbox_rights; (** server-set *)

     

       63
       63
       +
         is_subscribed : bool;

     

       64
       64
       +
       }

     

       65
       65
       +
       

     

       66
       66
       +
       (** Mailbox object for creation.

     

       67
       67
       +
           Excludes server-set fields.

     

       68
       68
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)

     

       69
       69
       +
       type mailbox_create = {

     

       70
       70
       +
         mailbox_create_name : string;

     

       71
       71
       +
         mailbox_create_parent_id : id option;

     

       72
       72
       +
         mailbox_create_role : role option;

     

       73
       73
       +
         mailbox_create_sort_order : uint option;

     

       74
       74
       +
         mailbox_create_is_subscribed : bool option;

     

       75
       75
       +
       }

     

       76
       76
       +
       

     

       77
       77
       +
       (** Mailbox object for update.

     

       78
       78
       +
           Patch object, specific structure not enforced here.

     

       79
       79
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       80
       80
       +
       type mailbox_update = patch_object

     

       81
       81
       +
       

     

       82
       82
       +
       (** Server-set info for created mailbox.

     

       83
       83
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       84
       84
       +
       type mailbox_created_info = {

     

       85
       85
       +
         mailbox_created_id : id;

     

       86
       86
       +
         mailbox_created_role : role option; (** If default used *)

     

       87
       87
       +
         mailbox_created_sort_order : uint; (** If default used *)

     

       88
       88
       +
         mailbox_created_total_emails : uint;

     

       89
       89
       +
         mailbox_created_unread_emails : uint;

     

       90
       90
       +
         mailbox_created_total_threads : uint;

     

       91
       91
       +
         mailbox_created_unread_threads : uint;

     

       92
       92
       +
         mailbox_created_my_rights : mailbox_rights;

     

       93
       93
       +
         mailbox_created_is_subscribed : bool; (** If default used *)

     

       94
       94
       +
       }

     

       95
       95
       +
       

     

       96
       96
       +
       (** Server-set/computed info for updated mailbox.

     

       97
       97
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)

     

       98
       98
       +
       type mailbox_updated_info = mailbox (* Contains only changed server-set props *)

     

       99
       99
       +
       

     

       100
       100
       +
       (** FilterCondition for Mailbox/query.

     

       101
       101
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.3> RFC 8621, Section 2.3 *)

     

       102
       102
       +
       type mailbox_filter_condition = {

     

       103
       103
       +
         filter_parent_id : id option option; (* Use option option for explicit null *)

     

       104
       104
       +
         filter_name : string option;

     

       105
       105
       +
         filter_role : role option option; (* Use option option for explicit null *)

     

       106
       106
       +
         filter_has_any_role : bool option;

     

       107
       107
       +
         filter_is_subscribed : bool option;

     

       108
       108
       +
       }

     

       109
       109
       +
       

     

       110
       110
       +
       (** {2 Role and Property Conversion Functions} *)

     

       111
       111
       +
       

     

       112
       112
       +
       (** Convert a role variant to its string representation *)

     

       113
       113
       +
       val role_to_string : role -> string

     

       114
       114
       +
       

     

       115
       115
       +
       (** Parse a string into a role variant *)

     

       116
       116
       +
       val string_to_role : string -> role

     

       117
       117
       +
       

     

       118
       118
       +
       (** Convert a property variant to its string representation *)

     

       119
       119
       +
       val property_to_string : property -> string

     

       120
       120
       +
       

     

       121
       121
       +
       (** Parse a string into a property variant *)

     

       122
       122
       +
       val string_to_property : string -> property

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get a list of common properties useful for displaying mailboxes *)

     

       125
       125
       +
       val common_properties : property list

     

       126
       126
       +
       

     

       127
       127
       +
       (** Get a list of all standard properties *)

     

       128
       128
       +
       val all_properties : property list

     

       129
       129
       +
       

     

       130
       130
       +
       (** Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)

     

       131
       131
       +
       val is_count_property : property -> bool

     

       132
       132
       +
       

     

       133
       133
       +
       (** {2 Mailbox Creation and Manipulation} *)

     

       134
       134
       +
       

     

       135
       135
       +
       (** Create a set of default rights with all permissions *)

     

       136
       136
       +
       val default_rights : unit -> mailbox_rights

     

       137
       137
       +
       

     

       138
       138
       +
       (** Create a set of read-only rights *)

     

       139
       139
       +
       val readonly_rights : unit -> mailbox_rights

     

       140
       140
       +
       

     

       141
       141
       +
       (** Create a new mailbox object with minimal required fields *)

     

       142
       142
       +
       val create : 

     

       143
       143
       +
         name:string -> 

     

       144
       144
       +
         ?parent_id:id -> 

     

       145
       145
       +
         ?role:role -> 

     

       146
       146
       +
         ?sort_order:uint -> 

     

       147
       147
       +
         ?is_subscribed:bool -> 

     

       148
       148
       +
         unit -> mailbox_create

     

       149
       149
       +
         

     

       150
       150
       +
       (** Build a patch object for updating mailbox properties *)

     

       151
       151
       +
       val update :

     

       152
       152
       +
         ?name:string ->

     

       153
       153
       +
         ?parent_id:id option ->

     

       154
       154
       +
         ?role:role option ->

     

       155
       155
       +
         ?sort_order:uint ->

     

       156
       156
       +
         ?is_subscribed:bool ->

     

       157
       157
       +
         unit -> mailbox_update

     

       158
       158
       +
         

     

       159
       159
       +
       (** Get the list of standard role names and their string representations *)

     

       160
       160
       +
       val standard_role_names : (role * string) list

     

       161
       161
       +
       

     

       162
       162
       +
       (** {2 Filter Construction} *)

     

       163
       163
       +
       

     

       164
       164
       +
       (** Create a filter to match mailboxes with a specific role *)

     

       165
       165
       +
       val filter_has_role : role -> Jmap.Methods.Filter.t

     

       166
       166
       +
       

     

       167
       167
       +
       (** Create a filter to match mailboxes with no role *)

     

       168
       168
       +
       val filter_has_no_role : unit -> Jmap.Methods.Filter.t

     

       169
       169
       +
       

     

       170
       170
       +
       (** Create a filter to match mailboxes that are child of a given parent *)

     

       171
       171
       +
       val filter_has_parent : id -> Jmap.Methods.Filter.t

     

       172
       172
       +
       

     

       173
       173
       +
       (** Create a filter to match mailboxes at the root level (no parent) *)

     

       174
       174
       +
       val filter_is_root : unit -> Jmap.Methods.Filter.t

     

       175
       175
       +
       

     

       176
       176
       +
       (** Create a filter to match subscribed mailboxes *)

     

       177
       177
       +
       val filter_is_subscribed : unit -> Jmap.Methods.Filter.t

     

       178
       178
       +
       

     

       179
       179
       +
       (** Create a filter to match unsubscribed mailboxes *)

     

       180
       180
       +
       val filter_is_not_subscribed : unit -> Jmap.Methods.Filter.t

     

       181
       181
       +
       

     

       182
       182
       +
       (** Create a filter to match mailboxes by name (using case-insensitive substring matching) *)

     

       183
       183
       +
       val filter_name_contains : string -> Jmap.Methods.Filter.t

jmap-email/jmap_search_snippet.ml

···

       1
       1
       +
       (* JMAP Search Snippet. *)

     

       2
       2
       +
       

     

       3
       3
       +
       (* SearchSnippet object.

     

       4
       4
       +
          Note: Does not have an 'id' property. *)

     

       5
       5
       +
       type t = {

     

       6
       6
       +
         email_id : Jmap.Types.id;

     

       7
       7
       +
         subject : string option;

     

       8
       8
       +
         preview : string option;

     

       9
       9
       +
       }

+11

jmap-email/jmap_search_snippet.mli

···

       1
       1
       +
       (** JMAP Search Snippet.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       3
       3
       +
       

     

       4
       4
       +
       (** SearchSnippet object.

     

       5
       5
       +
           Note: Does not have an 'id' property.

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)

     

       7
       7
       +
       type t = {

     

       8
       8
       +
         email_id : Jmap.Types.id;

     

       9
       9
       +
         subject : string option;

     

       10
       10
       +
         preview : string option;

     

       11
       11
       +
       }

+125

jmap-email/jmap_submission.ml

···

       1
       1
       +
       (* JMAP Email Submission. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       open Jmap.Methods

     

       5
       5
       +
       

     

       6
       6
       +
       (* Address object for Envelope. *)

     

       7
       7
       +
       type envelope_address = {

     

       8
       8
       +
         env_addr_email : string;

     

       9
       9
       +
         env_addr_parameters : Yojson.Safe.t string_map option;

     

       10
       10
       +
       }

     

       11
       11
       +
       

     

       12
       12
       +
       (* Envelope object. *)

     

       13
       13
       +
       type envelope = {

     

       14
       14
       +
         env_mail_from : envelope_address;

     

       15
       15
       +
         env_rcpt_to : envelope_address list;

     

       16
       16
       +
       }

     

       17
       17
       +
       

     

       18
       18
       +
       (* Delivery status for a recipient. *)

     

       19
       19
       +
       type delivery_status = {

     

       20
       20
       +
         delivery_smtp_reply : string;

     

       21
       21
       +
         delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];

     

       22
       22
       +
         delivery_displayed : [ `Yes | `Unknown ];

     

       23
       23
       +
       }

     

       24
       24
       +
       

     

       25
       25
       +
       (* EmailSubmission object. *)

     

       26
       26
       +
       type email_submission = {

     

       27
       27
       +
         email_sub_id : id; (* immutable, server-set *)

     

       28
       28
       +
         identity_id : id; (* immutable *)

     

       29
       29
       +
         email_id : id; (* immutable *)

     

       30
       30
       +
         thread_id : id; (* immutable, server-set *)

     

       31
       31
       +
         envelope : envelope option; (* immutable *)

     

       32
       32
       +
         send_at : utc_date; (* immutable, server-set *)

     

       33
       33
       +
         undo_status : [ `Pending | `Final | `Canceled ];

     

       34
       34
       +
         delivery_status : delivery_status string_map option; (* server-set *)

     

       35
       35
       +
         dsn_blob_ids : id list; (* server-set *)

     

       36
       36
       +
         mdn_blob_ids : id list; (* server-set *)

     

       37
       37
       +
       }

     

       38
       38
       +
       

     

       39
       39
       +
       (* EmailSubmission object for creation.

     

       40
       40
       +
          Excludes server-set fields. *)

     

       41
       41
       +
       type email_submission_create = {

     

       42
       42
       +
         email_sub_create_identity_id : id;

     

       43
       43
       +
         email_sub_create_email_id : id;

     

       44
       44
       +
         email_sub_create_envelope : envelope option;

     

       45
       45
       +
       }

     

       46
       46
       +
       

     

       47
       47
       +
       (* EmailSubmission object for update.

     

       48
       48
       +
          Only undoStatus can be updated (to 'canceled'). *)

     

       49
       49
       +
       type email_submission_update = patch_object

     

       50
       50
       +
       

     

       51
       51
       +
       (* Server-set info for created email submission. *)

     

       52
       52
       +
       type email_submission_created_info = {

     

       53
       53
       +
         email_sub_created_id : id;

     

       54
       54
       +
         email_sub_created_thread_id : id;

     

       55
       55
       +
         email_sub_created_send_at : utc_date;

     

       56
       56
       +
       }

     

       57
       57
       +
       

     

       58
       58
       +
       (* Server-set/computed info for updated email submission. *)

     

       59
       59
       +
       type email_submission_updated_info = email_submission (* Contains only changed server-set props *)

     

       60
       60
       +
       

     

       61
       61
       +
       (* FilterCondition for EmailSubmission/query. *)

     

       62
       62
       +
       type email_submission_filter_condition = {

     

       63
       63
       +
         filter_identity_ids : id list option;

     

       64
       64
       +
         filter_email_ids : id list option;

     

       65
       65
       +
         filter_thread_ids : id list option;

     

       66
       66
       +
         filter_undo_status : [ `Pending | `Final | `Canceled ] option;

     

       67
       67
       +
         filter_before : utc_date option;

     

       68
       68
       +
         filter_after : utc_date option;

     

       69
       69
       +
       }

     

       70
       70
       +
       

     

       71
       71
       +
       (* EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)

     

       72
       72
       +
       module Email_submission_get_args = struct

     

       73
       73
       +
         type t = email_submission Get_args.t

     

       74
       74
       +
       end

     

       75
       75
       +
       

     

       76
       76
       +
       (* EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)

     

       77
       77
       +
       module Email_submission_get_response = struct

     

       78
       78
       +
         type t = email_submission Get_response.t

     

       79
       79
       +
       end

     

       80
       80
       +
       

     

       81
       81
       +
       (* EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)

     

       82
       82
       +
       module Email_submission_changes_args = struct

     

       83
       83
       +
         type t = Changes_args.t

     

       84
       84
       +
       end

     

       85
       85
       +
       

     

       86
       86
       +
       (* EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)

     

       87
       87
       +
       module Email_submission_changes_response = struct

     

       88
       88
       +
         type t = Changes_response.t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (* EmailSubmission/query: Args type (specialized from [Query_args.t]). *)

     

       92
       92
       +
       module Email_submission_query_args = struct

     

       93
       93
       +
         type t = Query_args.t

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (* EmailSubmission/query: Response type (specialized from [Query_response.t]). *)

     

       97
       97
       +
       module Email_submission_query_response = struct

     

       98
       98
       +
         type t = Query_response.t

     

       99
       99
       +
       end

     

       100
       100
       +
       

     

       101
       101
       +
       (* EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)

     

       102
       102
       +
       module Email_submission_query_changes_args = struct

     

       103
       103
       +
         type t = Query_changes_args.t

     

       104
       104
       +
       end

     

       105
       105
       +
       

     

       106
       106
       +
       (* EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)

     

       107
       107
       +
       module Email_submission_query_changes_response = struct

     

       108
       108
       +
         type t = Query_changes_response.t

     

       109
       109
       +
       end

     

       110
       110
       +
       

     

       111
       111
       +
       (* EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).

     

       112
       112
       +
          Includes onSuccess arguments. *)

     

       113
       113
       +
       type email_submission_set_args = {

     

       114
       114
       +
         set_account_id : id;

     

       115
       115
       +
         set_if_in_state : string option;

     

       116
       116
       +
         set_create : email_submission_create id_map option;

     

       117
       117
       +
         set_update : email_submission_update id_map option;

     

       118
       118
       +
         set_destroy : id list option;

     

       119
       119
       +
         set_on_success_destroy_email : id list option;

     

       120
       120
       +
       }

     

       121
       121
       +
       

     

       122
       122
       +
       (* EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)

     

       123
       123
       +
       module Email_submission_set_response = struct

     

       124
       124
       +
         type t = (email_submission_created_info, email_submission_updated_info) Set_response.t

     

       125
       125
       +
       end

+136

jmap-email/jmap_submission.mli

···

       1
       1
       +
       (** JMAP Email Submission.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       

     

       7
       7
       +
       (** Address object for Envelope.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       9
       9
       +
       type envelope_address = {

     

       10
       10
       +
         env_addr_email : string;

     

       11
       11
       +
         env_addr_parameters : Yojson.Safe.t string_map option;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** Envelope object.

     

       15
       15
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       16
       16
       +
       type envelope = {

     

       17
       17
       +
         env_mail_from : envelope_address;

     

       18
       18
       +
         env_rcpt_to : envelope_address list;

     

       19
       19
       +
       }

     

       20
       20
       +
       

     

       21
       21
       +
       (** Delivery status for a recipient.

     

       22
       22
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       23
       23
       +
       type delivery_status = {

     

       24
       24
       +
         delivery_smtp_reply : string;

     

       25
       25
       +
         delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];

     

       26
       26
       +
         delivery_displayed : [ `Yes | `Unknown ];

     

       27
       27
       +
       }

     

       28
       28
       +
       

     

       29
       29
       +
       (** EmailSubmission object.

     

       30
       30
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       31
       31
       +
       type email_submission = {

     

       32
       32
       +
         email_sub_id : id; (** immutable, server-set *)

     

       33
       33
       +
         identity_id : id; (** immutable *)

     

       34
       34
       +
         email_id : id; (** immutable *)

     

       35
       35
       +
         thread_id : id; (** immutable, server-set *)

     

       36
       36
       +
         envelope : envelope option; (** immutable *)

     

       37
       37
       +
         send_at : utc_date; (** immutable, server-set *)

     

       38
       38
       +
         undo_status : [ `Pending | `Final | `Canceled ];

     

       39
       39
       +
         delivery_status : delivery_status string_map option; (** server-set *)

     

       40
       40
       +
         dsn_blob_ids : id list; (** server-set *)

     

       41
       41
       +
         mdn_blob_ids : id list; (** server-set *)

     

       42
       42
       +
       }

     

       43
       43
       +
       

     

       44
       44
       +
       (** EmailSubmission object for creation.

     

       45
       45
       +
           Excludes server-set fields.

     

       46
       46
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       47
       47
       +
       type email_submission_create = {

     

       48
       48
       +
         email_sub_create_identity_id : id;

     

       49
       49
       +
         email_sub_create_email_id : id;

     

       50
       50
       +
         email_sub_create_envelope : envelope option;

     

       51
       51
       +
       }

     

       52
       52
       +
       

     

       53
       53
       +
       (** EmailSubmission object for update.

     

       54
       54
       +
           Only undoStatus can be updated (to 'canceled').

     

       55
       55
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)

     

       56
       56
       +
       type email_submission_update = patch_object

     

       57
       57
       +
       

     

       58
       58
       +
       (** Server-set info for created email submission.

     

       59
       59
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       60
       60
       +
       type email_submission_created_info = {

     

       61
       61
       +
         email_sub_created_id : id;

     

       62
       62
       +
         email_sub_created_thread_id : id;

     

       63
       63
       +
         email_sub_created_send_at : utc_date;

     

       64
       64
       +
       }

     

       65
       65
       +
       

     

       66
       66
       +
       (** Server-set/computed info for updated email submission.

     

       67
       67
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       68
       68
       +
       type email_submission_updated_info = email_submission (* Contains only changed server-set props *)

     

       69
       69
       +
       

     

       70
       70
       +
       (** FilterCondition for EmailSubmission/query.

     

       71
       71
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.3> RFC 8621, Section 7.3 *)

     

       72
       72
       +
       type email_submission_filter_condition = {

     

       73
       73
       +
         filter_identity_ids : id list option;

     

       74
       74
       +
         filter_email_ids : id list option;

     

       75
       75
       +
         filter_thread_ids : id list option;

     

       76
       76
       +
         filter_undo_status : [ `Pending | `Final | `Canceled ] option;

     

       77
       77
       +
         filter_before : utc_date option;

     

       78
       78
       +
         filter_after : utc_date option;

     

       79
       79
       +
       }

     

       80
       80
       +
       

     

       81
       81
       +
       (** EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)

     

       82
       82
       +
       module Email_submission_get_args : sig

     

       83
       83
       +
         type t = email_submission Get_args.t

     

       84
       84
       +
       end

     

       85
       85
       +
       

     

       86
       86
       +
       (** EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)

     

       87
       87
       +
       module Email_submission_get_response : sig

     

       88
       88
       +
         type t = email_submission Get_response.t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)

     

       92
       92
       +
       module Email_submission_changes_args : sig

     

       93
       93
       +
         type t = Changes_args.t

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (** EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)

     

       97
       97
       +
       module Email_submission_changes_response : sig

     

       98
       98
       +
         type t = Changes_response.t

     

       99
       99
       +
       end

     

       100
       100
       +
       

     

       101
       101
       +
       (** EmailSubmission/query: Args type (specialized from [Query_args.t]). *)

     

       102
       102
       +
       module Email_submission_query_args : sig

     

       103
       103
       +
         type t = Query_args.t

     

       104
       104
       +
       end

     

       105
       105
       +
       

     

       106
       106
       +
       (** EmailSubmission/query: Response type (specialized from [Query_response.t]). *)

     

       107
       107
       +
       module Email_submission_query_response : sig

     

       108
       108
       +
         type t = Query_response.t

     

       109
       109
       +
       end

     

       110
       110
       +
       

     

       111
       111
       +
       (** EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)

     

       112
       112
       +
       module Email_submission_query_changes_args : sig

     

       113
       113
       +
         type t = Query_changes_args.t

     

       114
       114
       +
       end

     

       115
       115
       +
       

     

       116
       116
       +
       (** EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)

     

       117
       117
       +
       module Email_submission_query_changes_response : sig

     

       118
       118
       +
         type t = Query_changes_response.t

     

       119
       119
       +
       end

     

       120
       120
       +
       

     

       121
       121
       +
       (** EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).

     

       122
       122
       +
           Includes onSuccess arguments.

     

       123
       123
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)

     

       124
       124
       +
       type email_submission_set_args = {

     

       125
       125
       +
         set_account_id : id;

     

       126
       126
       +
         set_if_in_state : string option;

     

       127
       127
       +
         set_create : email_submission_create id_map option;

     

       128
       128
       +
         set_update : email_submission_update id_map option;

     

       129
       129
       +
         set_destroy : id list option;

     

       130
       130
       +
         set_on_success_destroy_email : id list option;

     

       131
       131
       +
       }

     

       132
       132
       +
       

     

       133
       133
       +
       (** EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)

     

       134
       134
       +
       module Email_submission_set_response : sig

     

       135
       135
       +
         type t = (email_submission_created_info, email_submission_updated_info) Set_response.t

     

       136
       136
       +
       end

+19

jmap-email/jmap_thread.ml

···

       1
       1
       +
       (* JMAP Thread. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       

     

       5
       5
       +
       (* Thread object. *)

     

       6
       6
       +
       module Thread = struct

     

       7
       7
       +
         type t = {

     

       8
       8
       +
           id_value: id;

     

       9
       9
       +
           email_ids_value: id list;

     

       10
       10
       +
         }

     

       11
       11
       +
       

     

       12
       12
       +
         let id t = t.id_value

     

       13
       13
       +
         let email_ids t = t.email_ids_value

     

       14
       14
       +
         

     

       15
       15
       +
         let v ~id ~email_ids = {

     

       16
       16
       +
           id_value = id;

     

       17
       17
       +
           email_ids_value = email_ids;

     

       18
       18
       +
         }

     

       19
       19
       +
       end

+15

jmap-email/jmap_thread.mli

···

       1
       1
       +
       (** JMAP Thread.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       

     

       6
       6
       +
       (** Thread object.

     

       7
       7
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)

     

       8
       8
       +
       module Thread : sig

     

       9
       9
       +
         type t

     

       10
       10
       +
       

     

       11
       11
       +
         val id : t -> id

     

       12
       12
       +
         val email_ids : t -> id list

     

       13
       13
       +
         

     

       14
       14
       +
         val v : id:id -> email_ids:id list -> t

     

       15
       15
       +
       end

+103

jmap-email/jmap_vacation.ml

···

       1
       1
       +
       (* JMAP Vacation Response. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap.Types

     

       4
       4
       +
       open Jmap.Methods

     

       5
       5
       +
       open Jmap.Error

     

       6
       6
       +
       

     

       7
       7
       +
       (* VacationResponse object.

     

       8
       8
       +
          Note: id is always "singleton". *)

     

       9
       9
       +
       module Vacation_response = struct

     

       10
       10
       +
         type t = {

     

       11
       11
       +
           id_value: id;

     

       12
       12
       +
           is_enabled_value: bool;

     

       13
       13
       +
           from_date_value: utc_date option;

     

       14
       14
       +
           to_date_value: utc_date option;

     

       15
       15
       +
           subject_value: string option;

     

       16
       16
       +
           text_body_value: string option;

     

       17
       17
       +
           html_body_value: string option;

     

       18
       18
       +
         }

     

       19
       19
       +
         

     

       20
       20
       +
         (* Id of the vacation response (immutable, server-set, MUST be "singleton") *)

     

       21
       21
       +
         let id t = t.id_value

     

       22
       22
       +
         let is_enabled t = t.is_enabled_value

     

       23
       23
       +
         let from_date t = t.from_date_value

     

       24
       24
       +
         let to_date t = t.to_date_value

     

       25
       25
       +
         let subject t = t.subject_value

     

       26
       26
       +
         let text_body t = t.text_body_value

     

       27
       27
       +
         let html_body t = t.html_body_value

     

       28
       28
       +
         

     

       29
       29
       +
         let v ~id ~is_enabled ?from_date ?to_date ?subject ?text_body ?html_body () = {

     

       30
       30
       +
           id_value = id;

     

       31
       31
       +
           is_enabled_value = is_enabled;

     

       32
       32
       +
           from_date_value = from_date;

     

       33
       33
       +
           to_date_value = to_date;

     

       34
       34
       +
           subject_value = subject;

     

       35
       35
       +
           text_body_value = text_body;

     

       36
       36
       +
           html_body_value = html_body;

     

       37
       37
       +
         }

     

       38
       38
       +
       end

     

       39
       39
       +
       

     

       40
       40
       +
       (* VacationResponse object for update.

     

       41
       41
       +
          Patch object, specific structure not enforced here. *)

     

       42
       42
       +
       type vacation_response_update = patch_object

     

       43
       43
       +
       

     

       44
       44
       +
       (* VacationResponse/get: Args type (specialized from ['record get_args]). *)

     

       45
       45
       +
       module Vacation_response_get_args = struct

     

       46
       46
       +
         type t = Vacation_response.t Get_args.t

     

       47
       47
       +
         

     

       48
       48
       +
         let v ~account_id ?ids ?properties () =

     

       49
       49
       +
           Get_args.v ~account_id ?ids ?properties ()

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (* VacationResponse/get: Response type (specialized from ['record get_response]). *)

     

       53
       53
       +
       module Vacation_response_get_response = struct 

     

       54
       54
       +
         type t = Vacation_response.t Get_response.t

     

       55
       55
       +
         

     

       56
       56
       +
         let v ~account_id ~state ~list ~not_found () =

     

       57
       57
       +
           Get_response.v ~account_id ~state ~list ~not_found ()

     

       58
       58
       +
       end

     

       59
       59
       +
       

     

       60
       60
       +
       (* VacationResponse/set: Args type.

     

       61
       61
       +
          Only allows update, id must be "singleton". *)

     

       62
       62
       +
       module Vacation_response_set_args = struct

     

       63
       63
       +
         type t = {

     

       64
       64
       +
           account_id_value: id;

     

       65
       65
       +
           if_in_state_value: string option;

     

       66
       66
       +
           update_value: vacation_response_update id_map option;

     

       67
       67
       +
         }

     

       68
       68
       +
         

     

       69
       69
       +
         let account_id t = t.account_id_value

     

       70
       70
       +
         let if_in_state t = t.if_in_state_value

     

       71
       71
       +
         let update t = t.update_value

     

       72
       72
       +
         

     

       73
       73
       +
         let v ~account_id ?if_in_state ?update () = {

     

       74
       74
       +
           account_id_value = account_id;

     

       75
       75
       +
           if_in_state_value = if_in_state;

     

       76
       76
       +
           update_value = update;

     

       77
       77
       +
         }

     

       78
       78
       +
       end

     

       79
       79
       +
       

     

       80
       80
       +
       (* VacationResponse/set: Response type. *)

     

       81
       81
       +
       module Vacation_response_set_response = struct

     

       82
       82
       +
         type t = {

     

       83
       83
       +
           account_id_value: id;

     

       84
       84
       +
           old_state_value: string option;

     

       85
       85
       +
           new_state_value: string;

     

       86
       86
       +
           updated_value: Vacation_response.t option id_map option;

     

       87
       87
       +
           not_updated_value: Set_error.t id_map option;

     

       88
       88
       +
         }

     

       89
       89
       +
         

     

       90
       90
       +
         let account_id t = t.account_id_value

     

       91
       91
       +
         let old_state t = t.old_state_value

     

       92
       92
       +
         let new_state t = t.new_state_value

     

       93
       93
       +
         let updated t = t.updated_value

     

       94
       94
       +
         let not_updated t = t.not_updated_value

     

       95
       95
       +
         

     

       96
       96
       +
         let v ~account_id ?old_state ~new_state ?updated ?not_updated () = {

     

       97
       97
       +
           account_id_value = account_id;

     

       98
       98
       +
           old_state_value = old_state;

     

       99
       99
       +
           new_state_value = new_state;

     

       100
       100
       +
           updated_value = updated;

     

       101
       101
       +
           not_updated_value = not_updated;

     

       102
       102
       +
         }

     

       103
       103
       +
       end

+102

jmap-email/jmap_vacation.mli

···

       1
       1
       +
       (** JMAP Vacation Response.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Methods

     

       6
       6
       +
       open Jmap.Error

     

       7
       7
       +
       

     

       8
       8
       +
       (** VacationResponse object.

     

       9
       9
       +
           Note: id is always "singleton".

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)

     

       11
       11
       +
       module Vacation_response : sig

     

       12
       12
       +
         type t

     

       13
       13
       +
         

     

       14
       14
       +
         (** Id of the vacation response (immutable, server-set, MUST be "singleton") *)

     

       15
       15
       +
         val id : t -> id

     

       16
       16
       +
         val is_enabled : t -> bool

     

       17
       17
       +
         val from_date : t -> utc_date option

     

       18
       18
       +
         val to_date : t -> utc_date option

     

       19
       19
       +
         val subject : t -> string option

     

       20
       20
       +
         val text_body : t -> string option

     

       21
       21
       +
         val html_body : t -> string option

     

       22
       22
       +
         

     

       23
       23
       +
         val v :

     

       24
       24
       +
           id:id ->

     

       25
       25
       +
           is_enabled:bool ->

     

       26
       26
       +
           ?from_date:utc_date ->

     

       27
       27
       +
           ?to_date:utc_date ->

     

       28
       28
       +
           ?subject:string ->

     

       29
       29
       +
           ?text_body:string ->

     

       30
       30
       +
           ?html_body:string ->

     

       31
       31
       +
           unit ->

     

       32
       32
       +
           t

     

       33
       33
       +
       end

     

       34
       34
       +
       

     

       35
       35
       +
       (** VacationResponse object for update.

     

       36
       36
       +
           Patch object, specific structure not enforced here.

     

       37
       37
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       38
       38
       +
       type vacation_response_update = patch_object

     

       39
       39
       +
       

     

       40
       40
       +
       (** VacationResponse/get: Args type (specialized from ['record get_args]). *)

     

       41
       41
       +
       module Vacation_response_get_args : sig

     

       42
       42
       +
         type t = Vacation_response.t Get_args.t

     

       43
       43
       +
         

     

       44
       44
       +
         val v :

     

       45
       45
       +
           account_id:id ->

     

       46
       46
       +
           ?ids:id list ->

     

       47
       47
       +
           ?properties:string list ->

     

       48
       48
       +
           unit ->

     

       49
       49
       +
           t

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** VacationResponse/get: Response type (specialized from ['record get_response]). *)

     

       53
       53
       +
       module Vacation_response_get_response : sig 

     

       54
       54
       +
         type t = Vacation_response.t Get_response.t

     

       55
       55
       +
         

     

       56
       56
       +
         val v :

     

       57
       57
       +
           account_id:id ->

     

       58
       58
       +
           state:string ->

     

       59
       59
       +
           list:Vacation_response.t list ->

     

       60
       60
       +
           not_found:id list ->

     

       61
       61
       +
           unit ->

     

       62
       62
       +
           t

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       (** VacationResponse/set: Args type.

     

       66
       66
       +
           Only allows update, id must be "singleton".

     

       67
       67
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       68
       68
       +
       module Vacation_response_set_args : sig

     

       69
       69
       +
         type t

     

       70
       70
       +
         

     

       71
       71
       +
         val account_id : t -> id

     

       72
       72
       +
         val if_in_state : t -> string option

     

       73
       73
       +
         val update : t -> vacation_response_update id_map option

     

       74
       74
       +
         

     

       75
       75
       +
         val v :

     

       76
       76
       +
           account_id:id ->

     

       77
       77
       +
           ?if_in_state:string ->

     

       78
       78
       +
           ?update:vacation_response_update id_map ->

     

       79
       79
       +
           unit ->

     

       80
       80
       +
           t

     

       81
       81
       +
       end

     

       82
       82
       +
       

     

       83
       83
       +
       (** VacationResponse/set: Response type.

     

       84
       84
       +
           @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)

     

       85
       85
       +
       module Vacation_response_set_response : sig

     

       86
       86
       +
         type t

     

       87
       87
       +
         

     

       88
       88
       +
         val account_id : t -> id

     

       89
       89
       +
         val old_state : t -> string option

     

       90
       90
       +
         val new_state : t -> string

     

       91
       91
       +
         val updated : t -> Vacation_response.t option id_map option

     

       92
       92
       +
         val not_updated : t -> Set_error.t id_map option

     

       93
       93
       +
         

     

       94
       94
       +
         val v :

     

       95
       95
       +
           account_id:id ->

     

       96
       96
       +
           ?old_state:string ->

     

       97
       97
       +
           new_state:string ->

     

       98
       98
       +
           ?updated:Vacation_response.t option id_map ->

     

       99
       99
       +
           ?not_updated:Set_error.t id_map ->

     

       100
       100
       +
           unit ->

     

       101
       101
       +
           t

     

       102
       102
       +
       end

+21

jmap-unix.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       name: "jmap-unix"

     

       3
       3
       +
       version: "~dev"

     

       4
       4
       +
       synopsis: "JMAP Unix implementation"

     

       5
       5
       +
       description: "Unix-specific implementation of the JMAP protocol (RFC8620)"

     

       6
       6
       +
       maintainer: ["maintainer@example.com"]

     

       7
       7
       +
       authors: ["JMAP OCaml Team"]

     

       8
       8
       +
       license: "MIT"

     

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

     

       10
       10
       +
       bug-reports: "https://github.com/example/jmap-ocaml/issues"

     

       11
       11
       +
       depends: [

     

       12
       12
       +
         "ocaml" {>= "4.08.0"}

     

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

     

       14
       14
       +
         "jmap"

     

       15
       15
       +
         "yojson" {>= "1.7.0"}

     

       16
       16
       +
         "uri" {>= "4.0.0"}

     

       17
       17
       +
         "unix"

     

       18
       18
       +
       ]

     

       19
       19
       +
       build: [

     

       20
       20
       +
         ["dune" "build" "-p" name "-j" jobs]

     

       21
       21
       +
       ]

+62

jmap-unix/README.md

···

       1
       1
       +
       # JMAP Unix Implementation

     

       2
       2
       +
       

     

       3
       3
       +
       This library provides Unix-specific implementation for the core JMAP protocol.

     

       4
       4
       +
       

     

       5
       5
       +
       ## Overview

     

       6
       6
       +
       

     

       7
       7
       +
       Jmap_unix provides the implementation needed to make actual connections to JMAP servers

     

       8
       8
       +
       using OCaml's Unix module. It handles:

     

       9
       9
       +
       

     

       10
       10
       +
       - HTTP connections to JMAP endpoints

     

       11
       11
       +
       - Authentication

     

       12
       12
       +
       - Session discovery

     

       13
       13
       +
       - Request/response handling

     

       14
       14
       +
       - Blob upload/download

     

       15
       15
       +
       - High-level email operations (Jmap_unix.Email)

     

       16
       16
       +
       

     

       17
       17
       +
       ## Usage

     

       18
       18
       +
       

     

       19
       19
       +
       ```ocaml

     

       20
       20
       +
       open Jmap

     

       21
       21
       +
       open Jmap_unix

     

       22
       22
       +
       

     

       23
       23
       +
       (* Create a connection to a JMAP server *)

     

       24
       24
       +
       let credentials = Basic("username", "password") in

     

       25
       25
       +
       let (ctx, session) = Jmap_unix.connect ~host:"jmap.example.com" ~credentials in

     

       26
       26
       +
       

     

       27
       27
       +
       (* Use the connection for JMAP requests *)

     

       28
       28
       +
       let response = Jmap_unix.request ctx request in

     

       29
       29
       +
       

     

       30
       30
       +
       (* Close the connection when done *)

     

       31
       31
       +
       Jmap_unix.close ctx

     

       32
       32
       +
       ```

     

       33
       33
       +
       

     

       34
       34
       +
       ## Email Operations

     

       35
       35
       +
       

     

       36
       36
       +
       The Email module provides high-level operations for working with emails:

     

       37
       37
       +
       

     

       38
       38
       +
       ```ocaml

     

       39
       39
       +
       open Jmap

     

       40
       40
       +
       open Jmap.Unix

     

       41
       41
       +
       

     

       42
       42
       +
       (* Get an email *)

     

       43
       43
       +
       let email = Email.get_email ctx ~account_id ~email_id ()

     

       44
       44
       +
       

     

       45
       45
       +
       (* Search for unread emails *)

     

       46
       46
       +
       let filter = Jmap_email.Email_filter.unread ()

     

       47
       47
       +
       let (ids, emails) = Email.search_emails ctx ~account_id ~filter ()

     

       48
       48
       +
       

     

       49
       49
       +
       (* Mark emails as read *)

     

       50
       50
       +
       Email.mark_as_seen ctx ~account_id ~email_ids:["email1"; "email2"] ()

     

       51
       51
       +
       

     

       52
       52
       +
       (* Move emails to another mailbox *)

     

       53
       53
       +
       Email.move_emails ctx ~account_id ~email_ids ~mailbox_id ()

     

       54
       54
       +
       ```

     

       55
       55
       +
       

     

       56
       56
       +
       ## Dependencies

     

       57
       57
       +
       

     

       58
       58
       +
       - jmap (core library)

     

       59
       59
       +
       - jmap-email (email types and helpers)

     

       60
       60
       +
       - yojson

     

       61
       61
       +
       - uri

     

       62
       62
       +
       - unix

jmap-unix/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap_unix)

     

       3
       3
       +
        (public_name jmap-unix)

     

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

     

       5
       5
       +
        (modules jmap_unix))

+672

jmap-unix/jmap_unix.ml

···

       1
       1
       +
       (* Unix-specific JMAP client implementation interface. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap

     

       4
       4
       +
       open Jmap.Types

     

       5
       5
       +
       open Jmap.Error

     

       6
       6
       +
       open Jmap.Session

     

       7
       7
       +
       open Jmap.Wire

     

       8
       8
       +
       

     

       9
       9
       +
       (* Configuration options for a JMAP client context *)

     

       10
       10
       +
       type client_config = {

     

       11
       11
       +
         connect_timeout : float option;        (* Connection timeout in seconds *)

     

       12
       12
       +
         request_timeout : float option;        (* Request timeout in seconds *)

     

       13
       13
       +
         max_concurrent_requests : int option;  (* Maximum concurrent requests *)

     

       14
       14
       +
         max_request_size : int option;         (* Maximum request size in bytes *)

     

       15
       15
       +
         user_agent : string option;            (* User-Agent header value *)

     

       16
       16
       +
         authentication_header : string option; (* Custom Authentication header name *)

     

       17
       17
       +
       }

     

       18
       18
       +
       

     

       19
       19
       +
       (* Authentication method options *)

     

       20
       20
       +
       type auth_method = 

     

       21
       21
       +
         | Basic of string * string                  (* Basic auth with username and password *)

     

       22
       22
       +
         | Bearer of string                          (* Bearer token auth *)

     

       23
       23
       +
         | Custom of (string * string)               (* Custom header name and value *)

     

       24
       24
       +
         | Session_cookie of (string * string)       (* Session cookie name and value *)

     

       25
       25
       +
         | No_auth                                   (* No authentication *)

     

       26
       26
       +
       

     

       27
       27
       +
       (* The internal state of a JMAP client connection *)

     

       28
       28
       +
       type context = {

     

       29
       29
       +
         config: client_config;

     

       30
       30
       +
         mutable session_url: Uri.t option;

     

       31
       31
       +
         mutable session: Session.t option;

     

       32
       32
       +
         mutable auth: auth_method;

     

       33
       33
       +
       }

     

       34
       34
       +
       

     

       35
       35
       +
       (* Represents an active EventSource connection *)

     

       36
       36
       +
       type event_source_connection = {

     

       37
       37
       +
         event_url: Uri.t;

     

       38
       38
       +
         mutable is_connected: bool;

     

       39
       39
       +
       }

     

       40
       40
       +
       

     

       41
       41
       +
       (* A request builder for constructing and sending JMAP requests *)

     

       42
       42
       +
       type request_builder = {

     

       43
       43
       +
         ctx: context;

     

       44
       44
       +
         mutable using: string list;

     

       45
       45
       +
         mutable method_calls: Invocation.t list;

     

       46
       46
       +
       }

     

       47
       47
       +
       

     

       48
       48
       +
       (* Create default configuration options *)

     

       49
       49
       +
       let default_config () = {

     

       50
       50
       +
         connect_timeout = Some 30.0;

     

       51
       51
       +
         request_timeout = Some 300.0;

     

       52
       52
       +
         max_concurrent_requests = Some 4;

     

       53
       53
       +
         max_request_size = Some (1024 * 1024 * 10); (* 10 MB *)

     

       54
       54
       +
         user_agent = Some "OCaml JMAP Unix Client/1.0";

     

       55
       55
       +
         authentication_header = None;

     

       56
       56
       +
       }

     

       57
       57
       +
       

     

       58
       58
       +
       (* Create a client context with the specified configuration *)

     

       59
       59
       +
       let create_client ?(config = default_config ()) () = {

     

       60
       60
       +
         config;

     

       61
       61
       +
         session_url = None;

     

       62
       62
       +
         session = None;

     

       63
       63
       +
         auth = No_auth;

     

       64
       64
       +
       }

     

       65
       65
       +
       

     

       66
       66
       +
       (* Mock implementation for the Unix connection *)

     

       67
       67
       +
       let connect ctx ?session_url ?username ~host ?port ?auth_method () =

     

       68
       68
       +
         (* In a real implementation, this would use Unix HTTP functions *)

     

       69
       69
       +
         let auth = match auth_method with

     

       70
       70
       +
           | Some auth -> auth

     

       71
       71
       +
           | None -> No_auth

     

       72
       72
       +
         in

     

       73
       73
       +
         

     

       74
       74
       +
         (* Store the auth method for future requests *)

     

       75
       75
       +
         ctx.auth <- auth;

     

       76
       76
       +
         

     

       77
       77
       +
         (* Set session URL, either directly or after discovery *)

     

       78
       78
       +
         let session_url = match session_url with

     

       79
       79
       +
           | Some url -> url

     

       80
       80
       +
           | None ->

     

       81
       81
       +
               (* In a real implementation, this would perform RFC 8620 discovery *)

     

       82
       82
       +
               let proto = "https" in

     

       83
       83
       +
               let host_with_port = match port with

     

       84
       84
       +
                 | Some p -> host ^ ":" ^ string_of_int p

     

       85
       85
       +
                 | None -> host

     

       86
       86
       +
               in

     

       87
       87
       +
               Uri.of_string (proto ^ "://" ^ host_with_port ^ "/.well-known/jmap")

     

       88
       88
       +
         in

     

       89
       89
       +
         ctx.session_url <- Some session_url;

     

       90
       90
       +
         

     

       91
       91
       +
         (* Create a mock session object for this example *)

     

       92
       92
       +
         let caps = Hashtbl.create 4 in

     

       93
       93
       +
         Hashtbl.add caps Jmap.capability_core (`Assoc []);

     

       94
       94
       +
         

     

       95
       95
       +
         let accounts = Hashtbl.create 1 in

     

       96
       96
       +
         let acct = Account.v 

     

       97
       97
       +
           ~name:"user@example.com" 

     

       98
       98
       +
           ~is_personal:true 

     

       99
       99
       +
           ~is_read_only:false 

     

       100
       100
       +
           ()

     

       101
       101
       +
         in

     

       102
       102
       +
         Hashtbl.add accounts "u1" acct;

     

       103
       103
       +
         

     

       104
       104
       +
         let primary = Hashtbl.create 1 in

     

       105
       105
       +
         Hashtbl.add primary Jmap.capability_core "u1";

     

       106
       106
       +
         

     

       107
       107
       +
         let api_url = 

     

       108
       108
       +
           Uri.of_string ("https://" ^ host ^ "/api/jmap")

     

       109
       109
       +
         in

     

       110
       110
       +
         

     

       111
       111
       +
         let session = Session.v

     

       112
       112
       +
           ~capabilities:caps

     

       113
       113
       +
           ~accounts

     

       114
       114
       +
           ~primary_accounts:primary

     

       115
       115
       +
           ~username:"user@example.com"

     

       116
       116
       +
           ~api_url

     

       117
       117
       +
           ~download_url:(Uri.of_string ("https://" ^ host ^ "/download/{accountId}/{blobId}"))

     

       118
       118
       +
           ~upload_url:(Uri.of_string ("https://" ^ host ^ "/upload/{accountId}"))

     

       119
       119
       +
           ~event_source_url:(Uri.of_string ("https://" ^ host ^ "/eventsource"))

     

       120
       120
       +
           ~state:"1"

     

       121
       121
       +
           ()

     

       122
       122
       +
         in

     

       123
       123
       +
         

     

       124
       124
       +
         ctx.session <- Some session;

     

       125
       125
       +
         Ok (ctx, session)

     

       126
       126
       +
       

     

       127
       127
       +
       (* Create a request builder for constructing a JMAP request *)

     

       128
       128
       +
       let build ctx = {

     

       129
       129
       +
         ctx;

     

       130
       130
       +
         using = [Jmap.capability_core]; (* Default to core capability *)

     

       131
       131
       +
         method_calls = [];

     

       132
       132
       +
       }

     

       133
       133
       +
       

     

       134
       134
       +
       (* Set the using capabilities for a request *)

     

       135
       135
       +
       let using builder capabilities = 

     

       136
       136
       +
         { builder with using = capabilities }

     

       137
       137
       +
       

     

       138
       138
       +
       (* Add a method call to a request builder *)

     

       139
       139
       +
       let add_method_call builder name args id =

     

       140
       140
       +
         let call = Invocation.v 

     

       141
       141
       +
           ~method_name:name 

     

       142
       142
       +
           ~arguments:args 

     

       143
       143
       +
           ~method_call_id:id 

     

       144
       144
       +
           ()

     

       145
       145
       +
         in

     

       146
       146
       +
         { builder with method_calls = builder.method_calls @ [call] }

     

       147
       147
       +
       

     

       148
       148
       +
       (* Create a reference to a previous method call result *)

     

       149
       149
       +
       let create_reference result_of name =

     

       150
       150
       +
         Jmap.Wire.Result_reference.v 

     

       151
       151
       +
           ~result_of

     

       152
       152
       +
           ~name

     

       153
       153
       +
           ~path:"" (* In a real implementation, this would include a JSON pointer *)

     

       154
       154
       +
           ()

     

       155
       155
       +
       

     

       156
       156
       +
       (* Execute a request and return the response *)

     

       157
       157
       +
       let execute builder =

     

       158
       158
       +
         match builder.ctx.session with

     

       159
       159
       +
         | None -> Error (protocol_error "No active session")

     

       160
       160
       +
         | Some session ->

     

       161
       161
       +
             (* In a real implementation, this would create and send an HTTP request *)

     

       162
       162
       +
             

     

       163
       163
       +
             (* Create a mock response for this implementation *)

     

       164
       164
       +
             let results = List.map (fun call ->

     

       165
       165
       +
               let method_name = Invocation.method_name call in

     

       166
       166
       +
               let call_id = Invocation.method_call_id call in

     

       167
       167
       +
               if method_name = "Core/echo" then

     

       168
       168
       +
                 (* Echo method implementation *)

     

       169
       169
       +
                 Ok call

     

       170
       170
       +
               else

     

       171
       171
       +
                 (* For other methods, return a method error *)

     

       172
       172
       +
                 Error (

     

       173
       173
       +
                   Method_error.v 

     

       174
       174
       +
                     ~description:(Method_error_description.v 

     

       175
       175
       +
                       ~description:"Method not implemented in mock" 

     

       176
       176
       +
                       ())

     

       177
       177
       +
                     `ServerUnavailable,

     

       178
       178
       +
                   "Mock implementation"

     

       179
       179
       +
                 )

     

       180
       180
       +
             ) builder.method_calls in

     

       181
       181
       +
             

     

       182
       182
       +
             let resp = Response.v

     

       183
       183
       +
               ~method_responses:results

     

       184
       184
       +
               ~session_state:(session |> Session.state)

     

       185
       185
       +
               ()

     

       186
       186
       +
             in

     

       187
       187
       +
             Ok resp

     

       188
       188
       +
       

     

       189
       189
       +
       (* Perform a JMAP API request *)

     

       190
       190
       +
       let request ctx req =

     

       191
       191
       +
         match ctx.session_url, ctx.session with

     

       192
       192
       +
         | None, _ -> Error (protocol_error "No session URL configured")

     

       193
       193
       +
         | _, None -> Error (protocol_error "No active session")

     

       194
       194
       +
         | Some url, Some session ->

     

       195
       195
       +
             (* In a real implementation, this would serialize the request and send it *)

     

       196
       196
       +
             

     

       197
       197
       +
             (* Mock response implementation *)

     

       198
       198
       +
             let method_calls = Request.method_calls req in

     

       199
       199
       +
             let results = List.map (fun call ->

     

       200
       200
       +
               let method_name = Invocation.method_name call in

     

       201
       201
       +
               let call_id = Invocation.method_call_id call in

     

       202
       202
       +
               if method_name = "Core/echo" then

     

       203
       203
       +
                 (* Echo method implementation *)

     

       204
       204
       +
                 Ok call

     

       205
       205
       +
               else

     

       206
       206
       +
                 (* For other methods, return a method error *)

     

       207
       207
       +
                 Error (

     

       208
       208
       +
                   Method_error.v 

     

       209
       209
       +
                     ~description:(Method_error_description.v 

     

       210
       210
       +
                       ~description:"Method not implemented in mock" 

     

       211
       211
       +
                       ())

     

       212
       212
       +
                     `ServerUnavailable,

     

       213
       213
       +
                   "Mock implementation"

     

       214
       214
       +
                 )

     

       215
       215
       +
             ) method_calls in

     

       216
       216
       +
             

     

       217
       217
       +
             let resp = Response.v

     

       218
       218
       +
               ~method_responses:results

     

       219
       219
       +
               ~session_state:(session |> Session.state)

     

       220
       220
       +
               ()

     

       221
       221
       +
             in

     

       222
       222
       +
             Ok resp

     

       223
       223
       +
       

     

       224
       224
       +
       (* Upload binary data *)

     

       225
       225
       +
       let upload ctx ~account_id ~content_type ~data_stream =

     

       226
       226
       +
         match ctx.session with

     

       227
       227
       +
         | None -> Error (protocol_error "No active session")

     

       228
       228
       +
         | Some session ->

     

       229
       229
       +
             (* In a real implementation, would upload the data stream *)

     

       230
       230
       +
             

     

       231
       231
       +
             (* Mock success response *)

     

       232
       232
       +
             let response = Jmap.Binary.Upload_response.v

     

       233
       233
       +
               ~account_id

     

       234
       234
       +
               ~blob_id:"b123456"

     

       235
       235
       +
               ~type_:content_type

     

       236
       236
       +
               ~size:1024 (* Mock size *)

     

       237
       237
       +
               ()

     

       238
       238
       +
             in

     

       239
       239
       +
             Ok response

     

       240
       240
       +
       

     

       241
       241
       +
       (* Download binary data *)

     

       242
       242
       +
       let download ctx ~account_id ~blob_id ?content_type ?name =

     

       243
       243
       +
         match ctx.session with

     

       244
       244
       +
         | None -> Error (protocol_error "No active session")

     

       245
       245
       +
         | Some session ->

     

       246
       246
       +
             (* In a real implementation, would download the data and return a stream *)

     

       247
       247
       +
             

     

       248
       248
       +
             (* Mock data stream - in real code, this would be read from the HTTP response *)

     

       249
       249
       +
             let mock_data = "This is mock downloaded data for blob " ^ blob_id in

     

       250
       250
       +
             let seq = Seq.cons mock_data Seq.empty in

     

       251
       251
       +
             Ok seq

     

       252
       252
       +
       

     

       253
       253
       +
       (* Copy blobs between accounts *)

     

       254
       254
       +
       let copy_blobs ctx ~from_account_id ~account_id ~blob_ids =

     

       255
       255
       +
         match ctx.session with

     

       256
       256
       +
         | None -> Error (protocol_error "No active session")

     

       257
       257
       +
         | Some session ->

     

       258
       258
       +
             (* In a real implementation, would perform server-side copy *)

     

       259
       259
       +
             

     

       260
       260
       +
             (* Mock success response with first blob copied and second failed *)

     

       261
       261
       +
             let copied = Hashtbl.create 1 in

     

       262
       262
       +
             Hashtbl.add copied (List.hd blob_ids) "b999999";

     

       263
       263
       +
             

     

       264
       264
       +
             let response = Jmap.Binary.Blob_copy_response.v

     

       265
       265
       +
               ~from_account_id

     

       266
       266
       +
               ~account_id

     

       267
       267
       +
               ~copied

     

       268
       268
       +
               ()

     

       269
       269
       +
             in

     

       270
       270
       +
             Ok response

     

       271
       271
       +
             

     

       272
       272
       +
       (* Connect to the EventSource for push notifications *)

     

       273
       273
       +
       let connect_event_source ctx ?types ?close_after ?ping =

     

       274
       274
       +
         match ctx.session with

     

       275
       275
       +
         | None -> Error (protocol_error "No active session")

     

       276
       276
       +
         | Some session ->

     

       277
       277
       +
             (* In a real implementation, would connect to EventSource URL *)

     

       278
       278
       +
             

     

       279
       279
       +
             (* Create mock connection *)

     

       280
       280
       +
             let event_url = Session.event_source_url session in

     

       281
       281
       +
             let conn = { event_url; is_connected = true } in

     

       282
       282
       +
             

     

       283
       283
       +
             (* Create a mock event sequence *)

     

       284
       284
       +
             let mock_state_change = 

     

       285
       285
       +
               let changed = Hashtbl.create 1 in

     

       286
       286
       +
               let account_id = "u1" in

     

       287
       287
       +
               let state_map = Hashtbl.create 2 in

     

       288
       288
       +
               Hashtbl.add state_map "Email" "s123";

     

       289
       289
       +
               Hashtbl.add state_map "Mailbox" "s456";

     

       290
       290
       +
               Hashtbl.add changed account_id state_map;

     

       291
       291
       +
               

     

       292
       292
       +
               Push.State_change.v ~changed ()

     

       293
       293
       +
             in

     

       294
       294
       +
             

     

       295
       295
       +
             let ping_data = 

     

       296
       296
       +
               Push.Event_source_ping_data.v ~interval:30 ()

     

       297
       297
       +
             in

     

       298
       298
       +
             

     

       299
       299
       +
             (* Create a sequence with one state event and one ping event *)

     

       300
       300
       +
             let events = Seq.cons (`State mock_state_change) 

     

       301
       301
       +
                            (Seq.cons (`Ping ping_data) Seq.empty) in

     

       302
       302
       +
             

     

       303
       303
       +
             Ok (conn, events)

     

       304
       304
       +
       

     

       305
       305
       +
       (* Create a websocket connection for JMAP over WebSocket *)

     

       306
       306
       +
       let connect_websocket ctx =

     

       307
       307
       +
         match ctx.session with

     

       308
       308
       +
         | None -> Error (protocol_error "No active session")

     

       309
       309
       +
         | Some session ->

     

       310
       310
       +
             (* In a real implementation, would connect via WebSocket *)

     

       311
       311
       +
             

     

       312
       312
       +
             (* Mock connection *)

     

       313
       313
       +
             let event_url = Session.api_url session in

     

       314
       314
       +
             let conn = { event_url; is_connected = true } in

     

       315
       315
       +
             Ok conn

     

       316
       316
       +
       

     

       317
       317
       +
       (* Send a message over a websocket connection *)

     

       318
       318
       +
       let websocket_send conn req =

     

       319
       319
       +
         if not conn.is_connected then

     

       320
       320
       +
           Error (protocol_error "WebSocket not connected")

     

       321
       321
       +
         else

     

       322
       322
       +
           (* In a real implementation, would send over WebSocket *)

     

       323
       323
       +
           

     

       324
       324
       +
           (* Mock response (same as request function) *)

     

       325
       325
       +
           let method_calls = Request.method_calls req in

     

       326
       326
       +
           let results = List.map (fun call ->

     

       327
       327
       +
             let method_name = Invocation.method_name call in

     

       328
       328
       +
             let call_id = Invocation.method_call_id call in

     

       329
       329
       +
             if method_name = "Core/echo" then

     

       330
       330
       +
               Ok call

     

       331
       331
       +
             else

     

       332
       332
       +
               Error (

     

       333
       333
       +
                 Method_error.v 

     

       334
       334
       +
                   ~description:(Method_error_description.v 

     

       335
       335
       +
                     ~description:"Method not implemented in mock" 

     

       336
       336
       +
                     ())

     

       337
       337
       +
                   `ServerUnavailable,

     

       338
       338
       +
                 "Mock implementation"

     

       339
       339
       +
               )

     

       340
       340
       +
           ) method_calls in

     

       341
       341
       +
           

     

       342
       342
       +
           let resp = Response.v

     

       343
       343
       +
             ~method_responses:results

     

       344
       344
       +
             ~session_state:"1"

     

       345
       345
       +
             ()

     

       346
       346
       +
           in

     

       347
       347
       +
           Ok resp

     

       348
       348
       +
       

     

       349
       349
       +
       (* Close an EventSource or WebSocket connection *)

     

       350
       350
       +
       let close_connection conn =

     

       351
       351
       +
         if not conn.is_connected then

     

       352
       352
       +
           Error (protocol_error "Connection already closed")

     

       353
       353
       +
         else begin

     

       354
       354
       +
           conn.is_connected <- false;

     

       355
       355
       +
           Ok ()

     

       356
       356
       +
         end

     

       357
       357
       +
       

     

       358
       358
       +
       (* Close the JMAP connection context *)

     

       359
       359
       +
       let close ctx =

     

       360
       360
       +
         ctx.session <- None;

     

       361
       361
       +
         ctx.session_url <- None;

     

       362
       362
       +
         Ok ()

     

       363
       363
       +
       

     

       364
       364
       +
       (* Helper functions for common tasks *)

     

       365
       365
       +
       

     

       366
       366
       +
       (* Helper to get a single object by ID *)

     

       367
       367
       +
       let get_object ctx ~method_name ~account_id ~object_id ?properties =

     

       368
       368
       +
         let properties_param = match properties with

     

       369
       369
       +
           | Some props -> `List (List.map (fun p -> `String p) props)

     

       370
       370
       +
           | None -> `Null

     

       371
       371
       +
         in

     

       372
       372
       +
         

     

       373
       373
       +
         let args = `Assoc [

     

       374
       374
       +
           ("accountId", `String account_id);

     

       375
       375
       +
           ("ids", `List [`String object_id]);

     

       376
       376
       +
           ("properties", properties_param);

     

       377
       377
       +
         ] in

     

       378
       378
       +
         

     

       379
       379
       +
         let request_builder = build ctx

     

       380
       380
       +
           |> add_method_call method_name args "r1"

     

       381
       381
       +
         in

     

       382
       382
       +
         

     

       383
       383
       +
         match execute request_builder with

     

       384
       384
       +
         | Error e -> Error e

     

       385
       385
       +
         | Ok response ->

     

       386
       386
       +
             (* Find the method response and extract the list with the object *)

     

       387
       387
       +
             match response |> Response.method_responses with

     

       388
       388
       +
             | [Ok invocation] when Invocation.method_name invocation = method_name ^ "/get" -> 

     

       389
       389
       +
                 let args = Invocation.arguments invocation in

     

       390
       390
       +
                 begin match Yojson.Safe.Util.member "list" args with

     

       391
       391
       +
                 | `List [obj] -> Ok obj

     

       392
       392
       +
                 | _ -> Error (protocol_error "Object not found or invalid response")

     

       393
       393
       +
                 end

     

       394
       394
       +
             | _ ->

     

       395
       395
       +
                 Error (protocol_error "Method response not found")

     

       396
       396
       +
       

     

       397
       397
       +
       (* Helper to set up the connection with minimal options *)

     

       398
       398
       +
       let quick_connect ~host ~username ~password =

     

       399
       399
       +
         let ctx = create_client () in

     

       400
       400
       +
         connect ctx ~host ~auth_method:(Basic(username, password)) ()

     

       401
       401
       +
       

     

       402
       402
       +
       (* Perform a Core/echo request to test connectivity *)

     

       403
       403
       +
       let echo ctx ?data () =

     

       404
       404
       +
         let data = match data with

     

       405
       405
       +
           | Some d -> d

     

       406
       406
       +
           | None -> `Assoc [("hello", `String "world")]

     

       407
       407
       +
         in

     

       408
       408
       +
         

     

       409
       409
       +
         let request_builder = build ctx

     

       410
       410
       +
           |> add_method_call "Core/echo" data "echo1"

     

       411
       411
       +
         in

     

       412
       412
       +
         

     

       413
       413
       +
         match execute request_builder with

     

       414
       414
       +
         | Error e -> Error e

     

       415
       415
       +
         | Ok response ->

     

       416
       416
       +
             (* Find the Core/echo response and extract the echoed data *)

     

       417
       417
       +
             match response |> Response.method_responses with

     

       418
       418
       +
             | [Ok invocation] when Invocation.method_name invocation = "Core/echo" -> 

     

       419
       419
       +
                 Ok (Invocation.arguments invocation)

     

       420
       420
       +
             | _ ->

     

       421
       421
       +
                 Error (protocol_error "Echo response not found")

     

       422
       422
       +
       

     

       423
       423
       +
       (* High-level email operations *)

     

       424
       424
       +
       module Email = struct

     

       425
       425
       +
         open Jmap_email.Types

     

       426
       426
       +
         

     

       427
       427
       +
         (* Get an email by ID *)

     

       428
       428
       +
         let get_email ctx ~account_id ~email_id ?properties () =

     

       429
       429
       +
           let props = match properties with

     

       430
       430
       +
             | Some p -> p

     

       431
       431
       +
             | None -> List.map email_property_to_string detailed_email_properties

     

       432
       432
       +
           in

     

       433
       433
       +
           

     

       434
       434
       +
           match get_object ctx ~method_name:"Email/get" ~account_id ~object_id:email_id ~properties:props with

     

       435
       435
       +
           | Error e -> Error e

     

       436
       436
       +
           | Ok json ->

     

       437
       437
       +
               (* In a real implementation, would parse the JSON into an Email.t structure *)

     

       438
       438
       +
               let mock_email = Email.create

     

       439
       439
       +
                 ~id:email_id

     

       440
       440
       +
                 ~thread_id:"t12345"

     

       441
       441
       +
                 ~mailbox_ids:(let h = Hashtbl.create 1 in Hashtbl.add h "inbox" true; h)

     

       442
       442
       +
                 ~keywords:(Keywords.of_list [Keywords.Seen])

     

       443
       443
       +
                 ~subject:"Mock Email Subject"

     

       444
       444
       +
                 ~preview:"This is a mock email..."

     

       445
       445
       +
                 ~from:[Email_address.v ~name:"Sender Name" ~email:"sender@example.com" ()]

     

       446
       446
       +
                 ~to_:[Email_address.v ~email:"recipient@example.com" ()]

     

       447
       447
       +
                 ()

     

       448
       448
       +
               in

     

       449
       449
       +
               Ok mock_email

     

       450
       450
       +
         

     

       451
       451
       +
         (* Search for emails using a filter *)

     

       452
       452
       +
         let search_emails ctx ~account_id ~filter ?sort ?limit ?position ?properties () =

     

       453
       453
       +
           (* Create the query args *)

     

       454
       454
       +
           let args = `Assoc [

     

       455
       455
       +
             ("accountId", `String account_id);

     

       456
       456
       +
             ("filter", Jmap.Methods.Filter.to_json filter);

     

       457
       457
       +
             ("sort", match sort with

     

       458
       458
       +
               | Some s -> `List [] (* Would convert sort params *)

     

       459
       459
       +
               | None -> `List [`Assoc [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);

     

       460
       460
       +
             ("limit", match limit with

     

       461
       461
       +
               | Some l -> `Int l

     

       462
       462
       +
               | None -> `Int 20);

     

       463
       463
       +
             ("position", match position with

     

       464
       464
       +
               | Some p -> `Int p

     

       465
       465
       +
               | None -> `Int 0);

     

       466
       466
       +
           ] in

     

       467
       467
       +
           

     

       468
       468
       +
           let request_builder = build ctx

     

       469
       469
       +
             |> add_method_call "Email/query" args "q1"

     

       470
       470
       +
           in

     

       471
       471
       +
           

     

       472
       472
       +
           (* If properties were provided, add a Email/get method call as well *)

     

       473
       473
       +
           let request_builder = match properties with

     

       474
       474
       +
             | Some _ -> 

     

       475
       475
       +
                 let get_args = `Assoc [

     

       476
       476
       +
                   ("accountId", `String account_id);

     

       477
       477
       +
                   ("#ids", `Assoc [

     

       478
       478
       +
                     ("resultOf", `String "q1");

     

       479
       479
       +
                     ("name", `String "Email/query");

     

       480
       480
       +
                     ("path", `String "/ids")

     

       481
       481
       +
                   ]);

     

       482
       482
       +
                   ("properties", match properties with

     

       483
       483
       +
                     | Some p -> `List (List.map (fun prop -> `String prop) p)

     

       484
       484
       +
                     | None -> `Null);

     

       485
       485
       +
                 ] in

     

       486
       486
       +
                 add_method_call request_builder "Email/get" get_args "g1"

     

       487
       487
       +
             | None -> request_builder

     

       488
       488
       +
           in

     

       489
       489
       +
           

     

       490
       490
       +
           match execute request_builder with

     

       491
       491
       +
           | Error e -> Error e

     

       492
       492
       +
           | Ok response ->

     

       493
       493
       +
               (* Find the query response and extract the IDs *)

     

       494
       494
       +
               match Response.method_responses response with

     

       495
       495
       +
               | [Ok q_inv; Ok g_inv] 

     

       496
       496
       +
                 when Invocation.method_name q_inv = "Email/query" 

     

       497
       497
       +
                 && Invocation.method_name g_inv = "Email/get" ->

     

       498
       498
       +
                   

     

       499
       499
       +
                   (* Extract IDs from query response *)

     

       500
       500
       +
                   let q_args = Invocation.arguments q_inv in

     

       501
       501
       +
                   let ids = match Yojson.Safe.Util.member "ids" q_args with

     

       502
       502
       +
                     | `List l -> List.map Yojson.Safe.Util.to_string l

     

       503
       503
       +
                     | _ -> []

     

       504
       504
       +
                   in

     

       505
       505
       +
                   

     

       506
       506
       +
                   (* Extract emails from get response *)

     

       507
       507
       +
                   let g_args = Invocation.arguments g_inv in

     

       508
       508
       +
                   (* In a real implementation, would parse each email in the list *)

     

       509
       509
       +
                   let emails = List.map (fun id ->

     

       510
       510
       +
                     Email.create

     

       511
       511
       +
                       ~id

     

       512
       512
       +
                       ~thread_id:("t" ^ id)

     

       513
       513
       +
                       ~subject:(Printf.sprintf "Mock Email %s" id)

     

       514
       514
       +
                       ()

     

       515
       515
       +
                   ) ids in

     

       516
       516
       +
                   

     

       517
       517
       +
                   Ok (ids, Some emails)

     

       518
       518
       +
                   

     

       519
       519
       +
               | [Ok q_inv] when Invocation.method_name q_inv = "Email/query" ->

     

       520
       520
       +
                   (* If only query was performed (no properties requested) *)

     

       521
       521
       +
                   let q_args = Invocation.arguments q_inv in

     

       522
       522
       +
                   let ids = match Yojson.Safe.Util.member "ids" q_args with

     

       523
       523
       +
                     | `List l -> List.map Yojson.Safe.Util.to_string l

     

       524
       524
       +
                     | _ -> []

     

       525
       525
       +
                   in

     

       526
       526
       +
                   

     

       527
       527
       +
                   Ok (ids, None)

     

       528
       528
       +
                   

     

       529
       529
       +
               | _ ->

     

       530
       530
       +
                   Error (protocol_error "Query response not found")

     

       531
       531
       +
         

     

       532
       532
       +
         (* Mark multiple emails with a keyword *)

     

       533
       533
       +
         let mark_emails ctx ~account_id ~email_ids ~keyword () =

     

       534
       534
       +
           (* Create the set args with a patch to add the keyword *)

     

       535
       535
       +
           let keyword_patch = Jmap_email.Keyword_ops.add_keyword_patch keyword in

     

       536
       536
       +
           

     

       537
       537
       +
           (* Create patches map for each email *)

     

       538
       538
       +
           let update = Hashtbl.create (List.length email_ids) in

     

       539
       539
       +
           List.iter (fun id ->

     

       540
       540
       +
             Hashtbl.add update id keyword_patch

     

       541
       541
       +
           ) email_ids;

     

       542
       542
       +
           

     

       543
       543
       +
           let args = `Assoc [

     

       544
       544
       +
             ("accountId", `String account_id);

     

       545
       545
       +
             ("update", `Assoc (

     

       546
       546
       +
               List.map (fun id ->

     

       547
       547
       +
                 (id, `Assoc (List.map (fun (path, value) ->

     

       548
       548
       +
                   (path, value)

     

       549
       549
       +
                 ) keyword_patch))

     

       550
       550
       +
               ) email_ids

     

       551
       551
       +
             ));

     

       552
       552
       +
           ] in

     

       553
       553
       +
           

     

       554
       554
       +
           let request_builder = build ctx

     

       555
       555
       +
             |> add_method_call "Email/set" args "s1"

     

       556
       556
       +
           in

     

       557
       557
       +
           

     

       558
       558
       +
           match execute request_builder with

     

       559
       559
       +
           | Error e -> Error e

     

       560
       560
       +
           | Ok response ->

     

       561
       561
       +
               (* In a real implementation, would check for errors *)

     

       562
       562
       +
               Ok ()

     

       563
       563
       +
         

     

       564
       564
       +
         (* Mark emails as seen/read *)

     

       565
       565
       +
         let mark_as_seen ctx ~account_id ~email_ids () =

     

       566
       566
       +
           mark_emails ctx ~account_id ~email_ids ~keyword:Keywords.Seen ()

     

       567
       567
       +
         

     

       568
       568
       +
         (* Mark emails as unseen/unread *)

     

       569
       569
       +
         let mark_as_unseen ctx ~account_id ~email_ids () =

     

       570
       570
       +
           let keyword_patch = Jmap_email.Keyword_ops.mark_unseen_patch () in

     

       571
       571
       +
           

     

       572
       572
       +
           (* Create patches map for each email *)

     

       573
       573
       +
           let update = Hashtbl.create (List.length email_ids) in

     

       574
       574
       +
           List.iter (fun id ->

     

       575
       575
       +
             Hashtbl.add update id keyword_patch

     

       576
       576
       +
           ) email_ids;

     

       577
       577
       +
           

     

       578
       578
       +
           let args = `Assoc [

     

       579
       579
       +
             ("accountId", `String account_id);

     

       580
       580
       +
             ("update", `Assoc (

     

       581
       581
       +
               List.map (fun id ->

     

       582
       582
       +
                 (id, `Assoc (List.map (fun (path, value) ->

     

       583
       583
       +
                   (path, value)

     

       584
       584
       +
                 ) keyword_patch))

     

       585
       585
       +
               ) email_ids

     

       586
       586
       +
             ));

     

       587
       587
       +
           ] in

     

       588
       588
       +
           

     

       589
       589
       +
           let request_builder = build ctx

     

       590
       590
       +
             |> add_method_call "Email/set" args "s1"

     

       591
       591
       +
           in

     

       592
       592
       +
           

     

       593
       593
       +
           match execute request_builder with

     

       594
       594
       +
           | Error e -> Error e

     

       595
       595
       +
           | Ok _response -> Ok ()

     

       596
       596
       +
         

     

       597
       597
       +
         (* Move emails to a different mailbox *)

     

       598
       598
       +
         let move_emails ctx ~account_id ~email_ids ~mailbox_id ?remove_from_mailboxes () =

     

       599
       599
       +
           (* Create patch to add to destination mailbox *)

     

       600
       600
       +
           let add_patch = [("mailboxIds/" ^ mailbox_id, `Bool true)] in

     

       601
       601
       +
           

     

       602
       602
       +
           (* If remove_from_mailboxes is specified, add patches to remove *)

     

       603
       603
       +
           let remove_patch = match remove_from_mailboxes with

     

       604
       604
       +
             | Some mailboxes -> 

     

       605
       605
       +
                 List.map (fun mbx -> ("mailboxIds/" ^ mbx, `Null)) mailboxes

     

       606
       606
       +
             | None -> []

     

       607
       607
       +
           in

     

       608
       608
       +
           

     

       609
       609
       +
           (* Combine patches *)

     

       610
       610
       +
           let patches = add_patch @ remove_patch in

     

       611
       611
       +
           

     

       612
       612
       +
           (* Create patches map for each email *)

     

       613
       613
       +
           let update = Hashtbl.create (List.length email_ids) in

     

       614
       614
       +
           List.iter (fun id ->

     

       615
       615
       +
             Hashtbl.add update id patches

     

       616
       616
       +
           ) email_ids;

     

       617
       617
       +
           

     

       618
       618
       +
           let args = `Assoc [

     

       619
       619
       +
             ("accountId", `String account_id);

     

       620
       620
       +
             ("update", `Assoc (

     

       621
       621
       +
               List.map (fun id ->

     

       622
       622
       +
                 (id, `Assoc (List.map (fun (path, value) ->

     

       623
       623
       +
                   (path, value)

     

       624
       624
       +
                 ) patches))

     

       625
       625
       +
               ) email_ids

     

       626
       626
       +
             ));

     

       627
       627
       +
           ] in

     

       628
       628
       +
           

     

       629
       629
       +
           let request_builder = build ctx

     

       630
       630
       +
             |> add_method_call "Email/set" args "s1"

     

       631
       631
       +
           in

     

       632
       632
       +
           

     

       633
       633
       +
           match execute request_builder with

     

       634
       634
       +
           | Error e -> Error e

     

       635
       635
       +
           | Ok _response -> Ok ()

     

       636
       636
       +
         

     

       637
       637
       +
         (* Import an RFC822 message *)

     

       638
       638
       +
         let import_email ctx ~account_id ~rfc822 ~mailbox_ids ?keywords ?received_at () =

     

       639
       639
       +
           (* In a real implementation, would first upload the message as a blob *)

     

       640
       640
       +
           let mock_blob_id = "b9876" in

     

       641
       641
       +
           

     

       642
       642
       +
           (* Create the Email/import call *)

     

       643
       643
       +
           let args = `Assoc [

     

       644
       644
       +
             ("accountId", `String account_id);

     

       645
       645
       +
             ("emails", `Assoc [

     

       646
       646
       +
               ("msg1", `Assoc [

     

       647
       647
       +
                 ("blobId", `String mock_blob_id);

     

       648
       648
       +
                 ("mailboxIds", `Assoc (

     

       649
       649
       +
                   List.map (fun id -> (id, `Bool true)) mailbox_ids

     

       650
       650
       +
                 ));

     

       651
       651
       +
                 ("keywords", match keywords with

     

       652
       652
       +
                   | Some kws -> 

     

       653
       653
       +
                       `Assoc (List.map (fun k -> 

     

       654
       654
       +
                         (Types.Keywords.to_string k, `Bool true)) kws)

     

       655
       655
       +
                   | None -> `Null);

     

       656
       656
       +
                 ("receivedAt", match received_at with

     

       657
       657
       +
                   | Some d -> `String (string_of_float d) (* Would format as RFC3339 *)

     

       658
       658
       +
                   | None -> `Null);

     

       659
       659
       +
               ])

     

       660
       660
       +
             ]);

     

       661
       661
       +
           ] in

     

       662
       662
       +
           

     

       663
       663
       +
           let request_builder = build ctx

     

       664
       664
       +
             |> add_method_call "Email/import" args "i1"

     

       665
       665
       +
           in

     

       666
       666
       +
           

     

       667
       667
       +
           match execute request_builder with

     

       668
       668
       +
           | Error e -> Error e

     

       669
       669
       +
           | Ok response ->

     

       670
       670
       +
               (* In a real implementation, would extract the created ID *)

     

       671
       671
       +
               Ok "e12345"

     

       672
       672
       +
       end

+359

jmap-unix/jmap_unix.mli

···

       1
       1
       +
       (** Unix-specific JMAP client implementation interface.

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides functions to interact with a JMAP server using

     

       4
       4
       +
           Unix sockets for network communication.

     

       5
       5
       +
           

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4

     

       7
       7
       +
       *)

     

       8
       8
       +
       

     

       9
       9
       +
       (** Configuration options for a JMAP client context *)

     

       10
       10
       +
       type client_config = {

     

       11
       11
       +
         connect_timeout : float option;        (** Connection timeout in seconds *)

     

       12
       12
       +
         request_timeout : float option;        (** Request timeout in seconds *)

     

       13
       13
       +
         max_concurrent_requests : int option;  (** Maximum concurrent requests *)

     

       14
       14
       +
         max_request_size : int option;         (** Maximum request size in bytes *)

     

       15
       15
       +
         user_agent : string option;            (** User-Agent header value *)

     

       16
       16
       +
         authentication_header : string option; (** Custom Authentication header name *)

     

       17
       17
       +
       }

     

       18
       18
       +
       

     

       19
       19
       +
       (** Authentication method options *)

     

       20
       20
       +
       type auth_method = 

     

       21
       21
       +
         | Basic of string * string                  (** Basic auth with username and password *)

     

       22
       22
       +
         | Bearer of string                          (** Bearer token auth *)

     

       23
       23
       +
         | Custom of (string * string)               (** Custom header name and value *)

     

       24
       24
       +
         | Session_cookie of (string * string)       (** Session cookie name and value *)

     

       25
       25
       +
         | No_auth                                   (** No authentication *)

     

       26
       26
       +
       

     

       27
       27
       +
       (** Represents an active JMAP connection context. Opaque type. *)

     

       28
       28
       +
       type context

     

       29
       29
       +
       

     

       30
       30
       +
       (** Represents an active EventSource connection. Opaque type. *)

     

       31
       31
       +
       type event_source_connection

     

       32
       32
       +
       

     

       33
       33
       +
       (** A request builder for constructing and sending JMAP requests *)

     

       34
       34
       +
       type request_builder

     

       35
       35
       +
       

     

       36
       36
       +
       (** Create default configuration options *)

     

       37
       37
       +
       val default_config : unit -> client_config

     

       38
       38
       +
       

     

       39
       39
       +
       (** Create a client context with the specified configuration

     

       40
       40
       +
           @return The context object used for JMAP API calls

     

       41
       41
       +
       *)

     

       42
       42
       +
       val create_client : 

     

       43
       43
       +
         ?config:client_config -> 

     

       44
       44
       +
         unit -> 

     

       45
       45
       +
         context

     

       46
       46
       +
       

     

       47
       47
       +
       (** Connect to a JMAP server and retrieve the session.

     

       48
       48
       +
           This handles discovery (if needed) and authentication.

     

       49
       49
       +
           @param ctx The client context.

     

       50
       50
       +
           @param ?session_url Optional direct URL to the Session resource.

     

       51
       51
       +
           @param ?username Optional username (e.g., email address) for discovery.

     

       52
       52
       +
           @param ?auth_method Authentication method to use (default Basic).

     

       53
       53
       +
           @param credentials Authentication credentials.

     

       54
       54
       +
           @return A result with either (context, session) or an error.

     

       55
       55
       +
       *)

     

       56
       56
       +
       val connect : 

     

       57
       57
       +
         context ->

     

       58
       58
       +
         ?session_url:Uri.t ->

     

       59
       59
       +
         ?username:string ->

     

       60
       60
       +
         host:string -> 

     

       61
       61
       +
         ?port:int -> 

     

       62
       62
       +
         ?auth_method:auth_method ->

     

       63
       63
       +
         unit -> 

     

       64
       64
       +
         (context * Jmap.Session.Session.t) Jmap.Error.result

     

       65
       65
       +
       

     

       66
       66
       +
       (** Create a request builder for constructing a JMAP request.

     

       67
       67
       +
           @param ctx The client context.

     

       68
       68
       +
           @return A request builder object.

     

       69
       69
       +
       *)

     

       70
       70
       +
       val build : context -> request_builder

     

       71
       71
       +
       

     

       72
       72
       +
       (** Set the using capabilities for a request.

     

       73
       73
       +
           @param builder The request builder.

     

       74
       74
       +
           @param capabilities List of capability URIs to use.

     

       75
       75
       +
           @return The updated request builder.

     

       76
       76
       +
       *)

     

       77
       77
       +
       val using : request_builder -> string list -> request_builder

     

       78
       78
       +
       

     

       79
       79
       +
       (** Add a method call to a request builder.

     

       80
       80
       +
           @param builder The request builder.

     

       81
       81
       +
           @param name Method name (e.g., "Email/get").

     

       82
       82
       +
           @param args Method arguments.

     

       83
       83
       +
           @param id Method call ID.

     

       84
       84
       +
           @return The updated request builder.

     

       85
       85
       +
       *)

     

       86
       86
       +
       val add_method_call : 

     

       87
       87
       +
         request_builder -> 

     

       88
       88
       +
         string -> 

     

       89
       89
       +
         Yojson.Safe.t -> 

     

       90
       90
       +
         string -> 

     

       91
       91
       +
         request_builder

     

       92
       92
       +
       

     

       93
       93
       +
       (** Create a reference to a previous method call result.

     

       94
       94
       +
           @param result_of Method call ID to reference.

     

       95
       95
       +
           @param name Path in the response.

     

       96
       96
       +
           @return A ResultReference to use in another method call.

     

       97
       97
       +
       *)

     

       98
       98
       +
       val create_reference : string -> string -> Jmap.Wire.Result_reference.t

     

       99
       99
       +
       

     

       100
       100
       +
       (** Execute a request and return the response.

     

       101
       101
       +
           @param builder The request builder to execute.

     

       102
       102
       +
           @return The JMAP response from the server.

     

       103
       103
       +
       *)

     

       104
       104
       +
       val execute : request_builder -> Jmap.Wire.Response.t Jmap.Error.result 

     

       105
       105
       +
       

     

       106
       106
       +
       (** Perform a JMAP API request.

     

       107
       107
       +
           @param ctx The connection context.

     

       108
       108
       +
           @param request The JMAP request object.

     

       109
       109
       +
           @return The JMAP response from the server.

     

       110
       110
       +
       *)

     

       111
       111
       +
       val request : context -> Jmap.Wire.Request.t -> Jmap.Wire.Response.t Jmap.Error.result

     

       112
       112
       +
       

     

       113
       113
       +
       (** Upload binary data.

     

       114
       114
       +
           @param ctx The connection context.

     

       115
       115
       +
           @param account_id The target account ID.

     

       116
       116
       +
           @param content_type The MIME type of the data.

     

       117
       117
       +
           @param data_stream A stream providing the binary data chunks.

     

       118
       118
       +
           @return A result with either an upload response or an error.

     

       119
       119
       +
       *)

     

       120
       120
       +
       val upload : 

     

       121
       121
       +
         context -> 

     

       122
       122
       +
         account_id:Jmap.Types.id -> 

     

       123
       123
       +
         content_type:string -> 

     

       124
       124
       +
         data_stream:string Seq.t -> 

     

       125
       125
       +
         Jmap.Binary.Upload_response.t Jmap.Error.result

     

       126
       126
       +
       

     

       127
       127
       +
       (** Download binary data.

     

       128
       128
       +
           @param ctx The connection context.

     

       129
       129
       +
           @param account_id The account ID.

     

       130
       130
       +
           @param blob_id The blob ID to download.

     

       131
       131
       +
           @param ?content_type The desired Content-Type for the download response.

     

       132
       132
       +
           @param ?name The desired filename for the download response.

     

       133
       133
       +
           @return A result with either a stream of data chunks or an error.

     

       134
       134
       +
       *)

     

       135
       135
       +
       val download : 

     

       136
       136
       +
         context -> 

     

       137
       137
       +
         account_id:Jmap.Types.id -> 

     

       138
       138
       +
         blob_id:Jmap.Types.id -> 

     

       139
       139
       +
         ?content_type:string -> 

     

       140
       140
       +
         ?name:string -> 

     

       141
       141
       +
         (string Seq.t) Jmap.Error.result

     

       142
       142
       +
       

     

       143
       143
       +
       (** Copy blobs between accounts.

     

       144
       144
       +
           @param ctx The connection context.

     

       145
       145
       +
           @param from_account_id Source account ID.

     

       146
       146
       +
           @param account_id Destination account ID.

     

       147
       147
       +
           @param blob_ids List of blob IDs to copy.

     

       148
       148
       +
           @return A result with either the copy response or an error.

     

       149
       149
       +
       *)

     

       150
       150
       +
       val copy_blobs :

     

       151
       151
       +
         context ->

     

       152
       152
       +
         from_account_id:Jmap.Types.id ->

     

       153
       153
       +
         account_id:Jmap.Types.id ->

     

       154
       154
       +
         blob_ids:Jmap.Types.id list ->

     

       155
       155
       +
         Jmap.Binary.Blob_copy_response.t Jmap.Error.result

     

       156
       156
       +
       

     

       157
       157
       +
       (** Connect to the EventSource for push notifications.

     

       158
       158
       +
           @param ctx The connection context.

     

       159
       159
       +
           @param ?types List of types to subscribe to (default "*").

     

       160
       160
       +
           @param ?close_after Request server to close after first state event.

     

       161
       161
       +
           @param ?ping Request ping interval in seconds (default 0).

     

       162
       162
       +
           @return A result with either a tuple of connection handle and event stream, or an error.

     

       163
       163
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)

     

       164
       164
       +
       val connect_event_source : 

     

       165
       165
       +
         context -> 

     

       166
       166
       +
         ?types:string list -> 

     

       167
       167
       +
         ?close_after:[`State | `No] -> 

     

       168
       168
       +
         ?ping:Jmap.Types.uint ->

     

       169
       169
       +
         (event_source_connection * 

     

       170
       170
       +
          ([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result

     

       171
       171
       +
       

     

       172
       172
       +
       (** Create a websocket connection for JMAP over WebSocket.

     

       173
       173
       +
           @param ctx The connection context.

     

       174
       174
       +
           @return A result with either a websocket connection or an error.

     

       175
       175
       +
           @see <https://www.rfc-editor.org/rfc/rfc8887.html> RFC 8887 *)

     

       176
       176
       +
       val connect_websocket :

     

       177
       177
       +
         context ->

     

       178
       178
       +
         event_source_connection Jmap.Error.result

     

       179
       179
       +
       

     

       180
       180
       +
       (** Send a message over a websocket connection.

     

       181
       181
       +
           @param conn The websocket connection.

     

       182
       182
       +
           @param request The JMAP request to send.

     

       183
       183
       +
           @return A result with either the response or an error.

     

       184
       184
       +
       *)

     

       185
       185
       +
       val websocket_send :

     

       186
       186
       +
         event_source_connection ->

     

       187
       187
       +
         Jmap.Wire.Request.t ->

     

       188
       188
       +
         Jmap.Wire.Response.t Jmap.Error.result

     

       189
       189
       +
       

     

       190
       190
       +
       (** Close an EventSource or WebSocket connection.

     

       191
       191
       +
           @param conn The connection handle.

     

       192
       192
       +
           @return A result with either unit or an error.

     

       193
       193
       +
       *)

     

       194
       194
       +
       val close_connection : event_source_connection -> unit Jmap.Error.result

     

       195
       195
       +
       

     

       196
       196
       +
       (** Close the JMAP connection context. 

     

       197
       197
       +
           @return A result with either unit or an error.

     

       198
       198
       +
       *)

     

       199
       199
       +
       val close : context -> unit Jmap.Error.result

     

       200
       200
       +
       

     

       201
       201
       +
       (** {2 Helper Methods for Common Tasks} *)

     

       202
       202
       +
       

     

       203
       203
       +
       (** Helper to get a single object by ID.

     

       204
       204
       +
           @param ctx The context.

     

       205
       205
       +
           @param method_name The get method (e.g., "Email/get").

     

       206
       206
       +
           @param account_id The account ID.

     

       207
       207
       +
           @param object_id The ID of the object to get.

     

       208
       208
       +
           @param ?properties Optional list of properties to fetch.

     

       209
       209
       +
           @return A result with either the object as JSON or an error.

     

       210
       210
       +
       *)

     

       211
       211
       +
       val get_object :

     

       212
       212
       +
         context ->

     

       213
       213
       +
         method_name:string ->

     

       214
       214
       +
         account_id:Jmap.Types.id ->

     

       215
       215
       +
         object_id:Jmap.Types.id ->

     

       216
       216
       +
         ?properties:string list ->

     

       217
       217
       +
         Yojson.Safe.t Jmap.Error.result

     

       218
       218
       +
       

     

       219
       219
       +
       (** Helper to set up the connection with minimal options.

     

       220
       220
       +
           @param host The JMAP server hostname.

     

       221
       221
       +
           @param username Username for basic auth.

     

       222
       222
       +
           @param password Password for basic auth.

     

       223
       223
       +
           @return A result with either (context, session) or an error.

     

       224
       224
       +
       *)

     

       225
       225
       +
       val quick_connect :

     

       226
       226
       +
         host:string ->

     

       227
       227
       +
         username:string ->

     

       228
       228
       +
         password:string ->

     

       229
       229
       +
         (context * Jmap.Session.Session.t) Jmap.Error.result

     

       230
       230
       +
       

     

       231
       231
       +
       (** Perform a Core/echo request to test connectivity.

     

       232
       232
       +
           @param ctx The JMAP connection context.

     

       233
       233
       +
           @param ?data Optional data to echo back.

     

       234
       234
       +
           @return A result with either the response or an error.

     

       235
       235
       +
       *)

     

       236
       236
       +
       val echo : 

     

       237
       237
       +
         context -> 

     

       238
       238
       +
         ?data:Yojson.Safe.t -> 

     

       239
       239
       +
         unit -> 

     

       240
       240
       +
         Yojson.Safe.t Jmap.Error.result

     

       241
       241
       +
       

     

       242
       242
       +
       (** {2 Email Operations} *)

     

       243
       243
       +
       

     

       244
       244
       +
       (** High-level email operations that map to JMAP email methods *)

     

       245
       245
       +
       module Email : sig

     

       246
       246
       +
         open Jmap_email.Types

     

       247
       247
       +
         

     

       248
       248
       +
         (** Get an email by ID 

     

       249
       249
       +
             @param ctx The JMAP client context

     

       250
       250
       +
             @param account_id The account ID

     

       251
       251
       +
             @param email_id The email ID to fetch

     

       252
       252
       +
             @param ?properties Optional list of properties to fetch

     

       253
       253
       +
             @return The email object or an error

     

       254
       254
       +
         *)

     

       255
       255
       +
         val get_email : 

     

       256
       256
       +
           context -> 

     

       257
       257
       +
           account_id:Jmap.Types.id -> 

     

       258
       258
       +
           email_id:Jmap.Types.id -> 

     

       259
       259
       +
           ?properties:string list -> 

     

       260
       260
       +
           unit -> 

     

       261
       261
       +
           Email.t Jmap.Error.result

     

       262
       262
       +
         

     

       263
       263
       +
         (** Search for emails using a filter

     

       264
       264
       +
             @param ctx The JMAP client context

     

       265
       265
       +
             @param account_id The account ID

     

       266
       266
       +
             @param filter The search filter

     

       267
       267
       +
             @param ?sort Optional sort criteria (default received date newest first)

     

       268
       268
       +
             @param ?limit Optional maximum number of results

     

       269
       269
       +
             @param ?properties Optional properties to fetch for the matching emails

     

       270
       270
       +
             @return The list of matching email IDs and optionally the email objects

     

       271
       271
       +
         *)

     

       272
       272
       +
         val search_emails :

     

       273
       273
       +
           context ->

     

       274
       274
       +
           account_id:Jmap.Types.id ->

     

       275
       275
       +
           filter:Jmap.Methods.Filter.t ->

     

       276
       276
       +
           ?sort:Jmap.Methods.Comparator.t list ->

     

       277
       277
       +
           ?limit:Jmap.Types.uint ->

     

       278
       278
       +
           ?position:int ->

     

       279
       279
       +
           ?properties:string list ->

     

       280
       280
       +
           unit ->

     

       281
       281
       +
           (Jmap.Types.id list * Email.t list option) Jmap.Error.result

     

       282
       282
       +
           

     

       283
       283
       +
         (** Mark multiple emails with a keyword

     

       284
       284
       +
             @param ctx The JMAP client context

     

       285
       285
       +
             @param account_id The account ID

     

       286
       286
       +
             @param email_ids List of email IDs to update

     

       287
       287
       +
             @param keyword The keyword to add

     

       288
       288
       +
             @return The result of the operation

     

       289
       289
       +
         *)

     

       290
       290
       +
         val mark_emails :

     

       291
       291
       +
           context ->

     

       292
       292
       +
           account_id:Jmap.Types.id ->

     

       293
       293
       +
           email_ids:Jmap.Types.id list ->

     

       294
       294
       +
           keyword:Keywords.keyword ->

     

       295
       295
       +
           unit ->

     

       296
       296
       +
           unit Jmap.Error.result

     

       297
       297
       +
           

     

       298
       298
       +
         (** Mark emails as seen/read

     

       299
       299
       +
             @param ctx The JMAP client context

     

       300
       300
       +
             @param account_id The account ID

     

       301
       301
       +
             @param email_ids List of email IDs to mark

     

       302
       302
       +
             @return The result of the operation

     

       303
       303
       +
         *)

     

       304
       304
       +
         val mark_as_seen :

     

       305
       305
       +
           context ->

     

       306
       306
       +
           account_id:Jmap.Types.id ->

     

       307
       307
       +
           email_ids:Jmap.Types.id list ->

     

       308
       308
       +
           unit ->

     

       309
       309
       +
           unit Jmap.Error.result

     

       310
       310
       +
           

     

       311
       311
       +
         (** Mark emails as unseen/unread

     

       312
       312
       +
             @param ctx The JMAP client context

     

       313
       313
       +
             @param account_id The account ID

     

       314
       314
       +
             @param email_ids List of email IDs to mark

     

       315
       315
       +
             @return The result of the operation

     

       316
       316
       +
         *)

     

       317
       317
       +
         val mark_as_unseen :

     

       318
       318
       +
           context ->

     

       319
       319
       +
           account_id:Jmap.Types.id ->

     

       320
       320
       +
           email_ids:Jmap.Types.id list ->

     

       321
       321
       +
           unit ->

     

       322
       322
       +
           unit Jmap.Error.result

     

       323
       323
       +
         

     

       324
       324
       +
         (** Move emails to a different mailbox

     

       325
       325
       +
             @param ctx The JMAP client context

     

       326
       326
       +
             @param account_id The account ID

     

       327
       327
       +
             @param email_ids List of email IDs to move

     

       328
       328
       +
             @param mailbox_id Destination mailbox ID

     

       329
       329
       +
             @param ?remove_from_mailboxes Optional list of source mailbox IDs to remove from

     

       330
       330
       +
             @return The result of the operation

     

       331
       331
       +
         *)

     

       332
       332
       +
         val move_emails :

     

       333
       333
       +
           context ->

     

       334
       334
       +
           account_id:Jmap.Types.id ->

     

       335
       335
       +
           email_ids:Jmap.Types.id list ->

     

       336
       336
       +
           mailbox_id:Jmap.Types.id ->

     

       337
       337
       +
           ?remove_from_mailboxes:Jmap.Types.id list ->

     

       338
       338
       +
           unit ->

     

       339
       339
       +
           unit Jmap.Error.result

     

       340
       340
       +
         

     

       341
       341
       +
         (** Import an RFC822 message

     

       342
       342
       +
             @param ctx The JMAP client context

     

       343
       343
       +
             @param account_id The account ID

     

       344
       344
       +
             @param rfc822 Raw message content

     

       345
       345
       +
             @param mailbox_ids Mailboxes to add the message to

     

       346
       346
       +
             @param ?keywords Optional keywords to set

     

       347
       347
       +
             @param ?received_at Optional received timestamp

     

       348
       348
       +
             @return The ID of the imported email

     

       349
       349
       +
         *)

     

       350
       350
       +
         val import_email :

     

       351
       351
       +
           context ->

     

       352
       352
       +
           account_id:Jmap.Types.id ->

     

       353
       353
       +
           rfc822:string ->

     

       354
       354
       +
           mailbox_ids:Jmap.Types.id list ->

     

       355
       355
       +
           ?keywords:Keywords.t ->

     

       356
       356
       +
           ?received_at:Jmap.Types.date ->

     

       357
       357
       +
           unit ->

     

       358
       358
       +
           Jmap.Types.id Jmap.Error.result

     

       359
       359
       +
       end

+13

jmap/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name jmap)

     

       3
       3
       +
        (public_name jmap)

     

       4
       4
       +
        (libraries yojson uri)

     

       5
       5
       +
        (modules

     

       6
       6
       +
         jmap

     

       7
       7
       +
         jmap_types

     

       8
       8
       +
         jmap_error

     

       9
       9
       +
         jmap_wire

     

       10
       10
       +
         jmap_session

     

       11
       11
       +
         jmap_methods

     

       12
       12
       +
         jmap_binary

     

       13
       13
       +
         jmap_push))

+45

jmap/jmap.ml

···

       1
       1
       +
       (* JMAP Core Protocol Library Interface (RFC 8620) *)

     

       2
       2
       +
       

     

       3
       3
       +
       module Types = Jmap_types

     

       4
       4
       +
       module Error = Jmap_error

     

       5
       5
       +
       module Wire = Jmap_wire

     

       6
       6
       +
       module Session = Jmap_session

     

       7
       7
       +
       module Methods = Jmap_methods

     

       8
       8
       +
       module Binary = Jmap_binary

     

       9
       9
       +
       module Push = Jmap_push

     

       10
       10
       +
       

     

       11
       11
       +
       (* Capability URI for JMAP Core. *)

     

       12
       12
       +
       let capability_core = "urn:ietf:params:jmap:core"

     

       13
       13
       +
       

     

       14
       14
       +
       (* Check if a session supports a given capability. *)

     

       15
       15
       +
       let supports_capability session capability =

     

       16
       16
       +
         let caps = Session.Session.capabilities session in

     

       17
       17
       +
         Hashtbl.mem caps capability

     

       18
       18
       +
       

     

       19
       19
       +
       (* Get the primary account ID for a given capability. *)

     

       20
       20
       +
       let get_primary_account session capability =

     

       21
       21
       +
         let primary_accounts = Session.Session.primary_accounts session in

     

       22
       22
       +
         match Hashtbl.find_opt primary_accounts capability with

     

       23
       23
       +
         | Some account_id -> Ok account_id

     

       24
       24
       +
         | None -> Error (Error.protocol_error ("No primary account for capability: " ^ capability))

     

       25
       25
       +
       

     

       26
       26
       +
       (* Get the download URL for a blob. *)

     

       27
       27
       +
       let get_download_url session ~account_id ~blob_id ?name ?content_type () =

     

       28
       28
       +
         let base_url = Session.Session.download_url session in

     

       29
       29
       +
         let url_str = Uri.to_string base_url in

     

       30
       30
       +
         let url_str = url_str ^ "/accounts/" ^ account_id ^ "/blobs/" ^ blob_id in

     

       31
       31
       +
         let url = Uri.of_string url_str in

     

       32
       32
       +
         let url = match name with

     

       33
       33
       +
           | Some name -> Uri.add_query_param url ("name", [name])

     

       34
       34
       +
           | None -> url

     

       35
       35
       +
         in

     

       36
       36
       +
         match content_type with

     

       37
       37
       +
         | Some ct -> Uri.add_query_param url ("type", [ct])

     

       38
       38
       +
         | None -> url

     

       39
       39
       +
       

     

       40
       40
       +
       (* Get the upload URL for a blob. *)

     

       41
       41
       +
       let get_upload_url session ~account_id =

     

       42
       42
       +
         let base_url = Session.Session.upload_url session in

     

       43
       43
       +
         let url_str = Uri.to_string base_url in

     

       44
       44
       +
         let url_str = url_str ^ "/accounts/" ^ account_id in

     

       45
       45
       +
         Uri.of_string url_str

+136

jmap/jmap.mli

···

       1
       1
       +
       (** JMAP Core Protocol Library Interface (RFC 8620)

     

       2
       2
       +
           

     

       3
       3
       +
           This library provides OCaml types and function signatures for interacting

     

       4
       4
       +
           with a JMAP server according to the core protocol specification in RFC 8620.

     

       5
       5
       +
           

     

       6
       6
       +
           Modules:

     

       7
       7
       +
           - {!Jmap.Types}: Basic data types (Id, Date, etc.).

     

       8
       8
       +
           - {!Jmap.Error}: Error types (ProblemDetails, MethodError, SetError).

     

       9
       9
       +
           - {!Jmap.Wire}: Request and Response structures.

     

       10
       10
       +
           - {!Jmap.Session}: Session object and discovery.

     

       11
       11
       +
           - {!Jmap.Methods}: Standard method patterns (/get, /set, etc.) and Core/echo.

     

       12
       12
       +
           - {!Jmap.Binary}: Binary data upload/download types.

     

       13
       13
       +
           - {!Jmap.Push}: Push notification types (StateChange, PushSubscription).

     

       14
       14
       +
           

     

       15
       15
       +
           For email-specific extensions (RFC 8621), see the Jmap_email library.

     

       16
       16
       +
           For Unix-specific implementation, see the Jmap_unix library.

     

       17
       17
       +
           

     

       18
       18
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP

     

       19
       19
       +
       *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** {1 Core JMAP Types and Modules} *)

     

       22
       22
       +
       

     

       23
       23
       +
       module Types = Jmap_types

     

       24
       24
       +
       module Error = Jmap_error

     

       25
       25
       +
       module Wire = Jmap_wire

     

       26
       26
       +
       module Session = Jmap_session

     

       27
       27
       +
       module Methods = Jmap_methods

     

       28
       28
       +
       module Binary = Jmap_binary

     

       29
       29
       +
       module Push = Jmap_push

     

       30
       30
       +
       

     

       31
       31
       +
       (** {1 Example Usage} 

     

       32
       32
       +
       

     

       33
       33
       +
           The following example demonstrates using the Core JMAP library with the Unix implementation

     

       34
       34
       +
           to make a simple echo request.

     

       35
       35
       +
       

     

       36
       36
       +
       {[ 

     

       37
       37
       +
         (* OCaml 5.1 required for Lwt let operators *) 

     

       38
       38
       +
         open Lwt.Syntax 

     

       39
       39
       +
         open Jmap 

     

       40
       40
       +
         open Jmap.Types 

     

       41
       41
       +
         open Jmap.Wire 

     

       42
       42
       +
         open Jmap.Methods

     

       43
       43
       +
         open Jmap.Unix

     

       44
       44
       +
         

     

       45
       45
       +
         let simple_echo_request ctx session = 

     

       46
       46
       +
           (* Prepare an echo invocation *) 

     

       47
       47
       +
           let echo_args = Yojson.Safe.to_basic (`Assoc [

     

       48
       48
       +
             ("hello", `String "world");

     

       49
       49
       +
             ("array", `List [`Int 1; `Int 2; `Int 3]);

     

       50
       50
       +
           ]) in

     

       51
       51
       +
           

     

       52
       52
       +
           let echo_invocation = Invocation.v 

     

       53
       53
       +
             ~method_name:"Core/echo"

     

       54
       54
       +
             ~arguments:echo_args

     

       55
       55
       +
             ~method_call_id:"echo1"

     

       56
       56
       +
             ()

     

       57
       57
       +
           in

     

       58
       58
       +
       

     

       59
       59
       +
           (* Prepare the JMAP request *) 

     

       60
       60
       +
           let request = Request.v

     

       61
       61
       +
             ~using:[capability_core]

     

       62
       62
       +
             ~method_calls:[echo_invocation]

     

       63
       63
       +
             ()

     

       64
       64
       +
           in

     

       65
       65
       +
       

     

       66
       66
       +
           (* Send the request *) 

     

       67
       67
       +
           let* response = Jmap.Unix.request ctx request in

     

       68
       68
       +
       

     

       69
       69
       +
           (* Process the response *) 

     

       70
       70
       +
           match Wire.find_method_response response "echo1" with

     

       71
       71
       +
           | Some (method_name, args, _) when method_name = "Core/echo" ->

     

       72
       72
       +
               (* Echo response should contain the same arguments we sent *)

     

       73
       73
       +
               let hello_value = match Yojson.Safe.Util.member "hello" args with

     

       74
       74
       +
                 | `String s -> s

     

       75
       75
       +
                 | _ -> "not found"

     

       76
       76
       +
               in

     

       77
       77
       +
               Printf.printf "Echo response received: hello=%s\n" hello_value;

     

       78
       78
       +
               Lwt.return_unit

     

       79
       79
       +
           | _ ->

     

       80
       80
       +
               Printf.eprintf "Echo response not found or unexpected format\n";

     

       81
       81
       +
               Lwt.return_unit

     

       82
       82
       +
       

     

       83
       83
       +
         let main () = 

     

       84
       84
       +
           (* Authentication details are placeholder *) 

     

       85
       85
       +
           let credentials = "my_auth_token" in 

     

       86
       86
       +
           let* (ctx, session) = Jmap.Unix.connect ~host:"jmap.example.com" ~credentials in 

     

       87
       87
       +
           let* () = simple_echo_request ctx session in 

     

       88
       88
       +
           Jmap.Unix.close ctx 

     

       89
       89
       +
       

     

       90
       90
       +
         (* Lwt_main.run (main ()) *) 

     

       91
       91
       +
       ]} 

     

       92
       92
       +
       *)

     

       93
       93
       +
       

     

       94
       94
       +
       (** Capability URI for JMAP Core.

     

       95
       95
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       96
       96
       +
       val capability_core : string

     

       97
       97
       +
       

     

       98
       98
       +
       (** {1 Convenience Functions} *)

     

       99
       99
       +
       

     

       100
       100
       +
       (** Check if a session supports a given capability.

     

       101
       101
       +
           @param session The session object.

     

       102
       102
       +
           @param capability The capability URI to check.

     

       103
       103
       +
           @return True if supported, false otherwise.

     

       104
       104
       +
       *)

     

       105
       105
       +
       val supports_capability : Jmap_session.Session.t -> string -> bool

     

       106
       106
       +
       

     

       107
       107
       +
       (** Get the primary account ID for a given capability.

     

       108
       108
       +
           @param session The session object.

     

       109
       109
       +
           @param capability The capability URI.

     

       110
       110
       +
           @return The account ID or an error if not found.

     

       111
       111
       +
       *)

     

       112
       112
       +
       val get_primary_account : Jmap_session.Session.t -> string -> (Jmap_types.id, Error.error) result

     

       113
       113
       +
       

     

       114
       114
       +
       (** Get the download URL for a blob.

     

       115
       115
       +
           @param session The session object.

     

       116
       116
       +
           @param account_id The account ID.

     

       117
       117
       +
           @param blob_id The blob ID.

     

       118
       118
       +
           @param ?name Optional filename for the download.

     

       119
       119
       +
           @param ?content_type Optional content type for the download.

     

       120
       120
       +
           @return The download URL.

     

       121
       121
       +
       *)

     

       122
       122
       +
       val get_download_url : 

     

       123
       123
       +
         Jmap_session.Session.t -> 

     

       124
       124
       +
         account_id:Jmap_types.id -> 

     

       125
       125
       +
         blob_id:Jmap_types.id -> 

     

       126
       126
       +
         ?name:string -> 

     

       127
       127
       +
         ?content_type:string -> 

     

       128
       128
       +
         unit ->

     

       129
       129
       +
         Uri.t

     

       130
       130
       +
       

     

       131
       131
       +
       (** Get the upload URL for a blob.

     

       132
       132
       +
           @param session The session object.

     

       133
       133
       +
           @param account_id The account ID.

     

       134
       134
       +
           @return The upload URL.

     

       135
       135
       +
       *)

     

       136
       136
       +
       val get_upload_url : Jmap_session.Session.t -> account_id:Jmap_types.id -> Uri.t

+56

jmap/jmap_binary.ml

···

       1
       1
       +
       (* JMAP Binary Data Handling. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       open Jmap_error

     

       5
       5
       +
       

     

       6
       6
       +
       (* Response from uploading binary data. *)

     

       7
       7
       +
       module Upload_response = struct

     

       8
       8
       +
         type t = {

     

       9
       9
       +
           account_id: id;

     

       10
       10
       +
           blob_id: id;

     

       11
       11
       +
           type_: string;

     

       12
       12
       +
           size: uint;

     

       13
       13
       +
         }

     

       14
       14
       +
         

     

       15
       15
       +
         let account_id t = t.account_id

     

       16
       16
       +
         let blob_id t = t.blob_id

     

       17
       17
       +
         let type_ t = t.type_

     

       18
       18
       +
         let size t = t.size

     

       19
       19
       +
         

     

       20
       20
       +
         let v ~account_id ~blob_id ~type_ ~size () =

     

       21
       21
       +
           { account_id; blob_id; type_; size }

     

       22
       22
       +
       end

     

       23
       23
       +
       

     

       24
       24
       +
       (* Arguments for Blob/copy. *)

     

       25
       25
       +
       module Blob_copy_args = struct

     

       26
       26
       +
         type t = {

     

       27
       27
       +
           from_account_id: id;

     

       28
       28
       +
           account_id: id;

     

       29
       29
       +
           blob_ids: id list;

     

       30
       30
       +
         }

     

       31
       31
       +
         

     

       32
       32
       +
         let from_account_id t = t.from_account_id

     

       33
       33
       +
         let account_id t = t.account_id

     

       34
       34
       +
         let blob_ids t = t.blob_ids

     

       35
       35
       +
         

     

       36
       36
       +
         let v ~from_account_id ~account_id ~blob_ids () =

     

       37
       37
       +
           { from_account_id; account_id; blob_ids }

     

       38
       38
       +
       end

     

       39
       39
       +
       

     

       40
       40
       +
       (* Response for Blob/copy. *)

     

       41
       41
       +
       module Blob_copy_response = struct

     

       42
       42
       +
         type t = {

     

       43
       43
       +
           from_account_id: id;

     

       44
       44
       +
           account_id: id;

     

       45
       45
       +
           copied: id id_map option;

     

       46
       46
       +
           not_copied: Set_error.t id_map option;

     

       47
       47
       +
         }

     

       48
       48
       +
         

     

       49
       49
       +
         let from_account_id t = t.from_account_id

     

       50
       50
       +
         let account_id t = t.account_id

     

       51
       51
       +
         let copied t = t.copied

     

       52
       52
       +
         let not_copied t = t.not_copied

     

       53
       53
       +
         

     

       54
       54
       +
         let v ~from_account_id ~account_id ?copied ?not_copied () =

     

       55
       55
       +
           { from_account_id; account_id; copied; not_copied }

     

       56
       56
       +
       end

+60

jmap/jmap_binary.mli

···

       1
       1
       +
       (** JMAP Binary Data Handling.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       open Jmap_error

     

       6
       6
       +
       

     

       7
       7
       +
       (** Response from uploading binary data.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)

     

       9
       9
       +
       module Upload_response : sig

     

       10
       10
       +
         type t

     

       11
       11
       +
         

     

       12
       12
       +
         val account_id : t -> id

     

       13
       13
       +
         val blob_id : t -> id

     

       14
       14
       +
         val type_ : t -> string

     

       15
       15
       +
         val size : t -> uint

     

       16
       16
       +
         

     

       17
       17
       +
         val v :

     

       18
       18
       +
           account_id:id ->

     

       19
       19
       +
           blob_id:id ->

     

       20
       20
       +
           type_:string ->

     

       21
       21
       +
           size:uint ->

     

       22
       22
       +
           unit ->

     

       23
       23
       +
           t

     

       24
       24
       +
       end

     

       25
       25
       +
       

     

       26
       26
       +
       (** Arguments for Blob/copy.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)

     

       28
       28
       +
       module Blob_copy_args : sig

     

       29
       29
       +
         type t

     

       30
       30
       +
         

     

       31
       31
       +
         val from_account_id : t -> id

     

       32
       32
       +
         val account_id : t -> id

     

       33
       33
       +
         val blob_ids : t -> id list

     

       34
       34
       +
         

     

       35
       35
       +
         val v :

     

       36
       36
       +
           from_account_id:id ->

     

       37
       37
       +
           account_id:id ->

     

       38
       38
       +
           blob_ids:id list ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** Response for Blob/copy.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)

     

       45
       45
       +
       module Blob_copy_response : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         val from_account_id : t -> id

     

       49
       49
       +
         val account_id : t -> id

     

       50
       50
       +
         val copied : t -> id id_map option

     

       51
       51
       +
         val not_copied : t -> Set_error.t id_map option

     

       52
       52
       +
         

     

       53
       53
       +
         val v :

     

       54
       54
       +
           from_account_id:id ->

     

       55
       55
       +
           account_id:id ->

     

       56
       56
       +
           ?copied:id id_map ->

     

       57
       57
       +
           ?not_copied:Set_error.t id_map ->

     

       58
       58
       +
           unit ->

     

       59
       59
       +
           t

     

       60
       60
       +
       end

+266

jmap/jmap_error.ml

···

       1
       1
       +
       (* JMAP Error Types. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       

     

       5
       5
       +
       (* Standard Method-level error types. *)

     

       6
       6
       +
       type method_error_type = [

     

       7
       7
       +
         | `ServerUnavailable

     

       8
       8
       +
         | `ServerFail

     

       9
       9
       +
         | `ServerPartialFail

     

       10
       10
       +
         | `UnknownMethod

     

       11
       11
       +
         | `InvalidArguments

     

       12
       12
       +
         | `InvalidResultReference

     

       13
       13
       +
         | `Forbidden

     

       14
       14
       +
         | `AccountNotFound

     

       15
       15
       +
         | `AccountNotSupportedByMethod

     

       16
       16
       +
         | `AccountReadOnly

     

       17
       17
       +
         | `RequestTooLarge

     

       18
       18
       +
         | `CannotCalculateChanges

     

       19
       19
       +
         | `StateMismatch

     

       20
       20
       +
         | `AnchorNotFound

     

       21
       21
       +
         | `UnsupportedSort

     

       22
       22
       +
         | `UnsupportedFilter

     

       23
       23
       +
         | `TooManyChanges

     

       24
       24
       +
         | `FromAccountNotFound

     

       25
       25
       +
         | `FromAccountNotSupportedByMethod

     

       26
       26
       +
         | `Other_method_error of string

     

       27
       27
       +
       ]

     

       28
       28
       +
       

     

       29
       29
       +
       (* Standard SetError types. *)

     

       30
       30
       +
       type set_error_type = [

     

       31
       31
       +
         | `Forbidden

     

       32
       32
       +
         | `OverQuota

     

       33
       33
       +
         | `TooLarge

     

       34
       34
       +
         | `RateLimit

     

       35
       35
       +
         | `NotFound

     

       36
       36
       +
         | `InvalidPatch

     

       37
       37
       +
         | `WillDestroy

     

       38
       38
       +
         | `InvalidProperties

     

       39
       39
       +
         | `Singleton

     

       40
       40
       +
         | `AlreadyExists (* From /copy *)

     

       41
       41
       +
         | `MailboxHasChild (* RFC 8621 *)

     

       42
       42
       +
         | `MailboxHasEmail (* RFC 8621 *)

     

       43
       43
       +
         | `BlobNotFound (* RFC 8621 *)

     

       44
       44
       +
         | `TooManyKeywords (* RFC 8621 *)

     

       45
       45
       +
         | `TooManyMailboxes (* RFC 8621 *)

     

       46
       46
       +
         | `InvalidEmail (* RFC 8621 *)

     

       47
       47
       +
         | `TooManyRecipients (* RFC 8621 *)

     

       48
       48
       +
         | `NoRecipients (* RFC 8621 *)

     

       49
       49
       +
         | `InvalidRecipients (* RFC 8621 *)

     

       50
       50
       +
         | `ForbiddenMailFrom (* RFC 8621 *)

     

       51
       51
       +
         | `ForbiddenFrom (* RFC 8621 *)

     

       52
       52
       +
         | `ForbiddenToSend (* RFC 8621 *)

     

       53
       53
       +
         | `CannotUnsend (* RFC 8621 *)

     

       54
       54
       +
         | `Other_set_error of string (* For future or custom errors *)

     

       55
       55
       +
       ]

     

       56
       56
       +
       

     

       57
       57
       +
       (* Primary error type that can represent all JMAP errors *)

     

       58
       58
       +
       type error =

     

       59
       59
       +
         | Transport of string     (* Network/HTTP-level error *)

     

       60
       60
       +
         | Parse of string         (* JSON parsing error *)

     

       61
       61
       +
         | Protocol of string      (* JMAP protocol error *)

     

       62
       62
       +
         | Problem of string       (* Problem Details object error *)

     

       63
       63
       +
         | Method of method_error_type * string option (* Method error with optional description *)

     

       64
       64
       +
         | SetItem of id * set_error_type * string option (* Error for a specific item in a /set operation *)

     

       65
       65
       +
         | Auth of string          (* Authentication error *)

     

       66
       66
       +
         | ServerError of string   (* Server reported an error *)

     

       67
       67
       +
       

     

       68
       68
       +
       (* Standard Result type for JMAP operations *)

     

       69
       69
       +
       type 'a result = ('a, error) Result.t

     

       70
       70
       +
       

     

       71
       71
       +
       (* Problem details object for HTTP-level errors. *)

     

       72
       72
       +
       module Problem_details = struct

     

       73
       73
       +
         type t = {

     

       74
       74
       +
           problem_type: string;

     

       75
       75
       +
           status: int option;

     

       76
       76
       +
           detail: string option;

     

       77
       77
       +
           limit: string option;

     

       78
       78
       +
           other_fields: Yojson.Safe.t string_map;

     

       79
       79
       +
         }

     

       80
       80
       +
       

     

       81
       81
       +
         let problem_type t = t.problem_type

     

       82
       82
       +
         let status t = t.status

     

       83
       83
       +
         let detail t = t.detail

     

       84
       84
       +
         let limit t = t.limit

     

       85
       85
       +
         let other_fields t = t.other_fields

     

       86
       86
       +
         

     

       87
       87
       +
         let v ?status ?detail ?limit ?(other_fields=Hashtbl.create 0) problem_type =

     

       88
       88
       +
           { problem_type; status; detail; limit; other_fields }

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (* Description for method errors. May contain additional details. *)

     

       92
       92
       +
       module Method_error_description = struct

     

       93
       93
       +
         type t = {

     

       94
       94
       +
           description: string option;

     

       95
       95
       +
         }

     

       96
       96
       +
         

     

       97
       97
       +
         let description t = t.description

     

       98
       98
       +
         

     

       99
       99
       +
         let v ?description () = { description }

     

       100
       100
       +
       end

     

       101
       101
       +
       

     

       102
       102
       +
       (* Represents a method-level error response invocation part. *)

     

       103
       103
       +
       module Method_error = struct

     

       104
       104
       +
         type t = {

     

       105
       105
       +
           type_: method_error_type;

     

       106
       106
       +
           description: Method_error_description.t option;

     

       107
       107
       +
         }

     

       108
       108
       +
         

     

       109
       109
       +
         let type_ t = t.type_

     

       110
       110
       +
         let description t = t.description

     

       111
       111
       +
         

     

       112
       112
       +
         let v ?description type_ = { type_; description }

     

       113
       113
       +
       end

     

       114
       114
       +
       

     

       115
       115
       +
       (* SetError object. *)

     

       116
       116
       +
       module Set_error = struct

     

       117
       117
       +
         type t = {

     

       118
       118
       +
           type_: set_error_type;

     

       119
       119
       +
           description: string option;

     

       120
       120
       +
           properties: string list option;

     

       121
       121
       +
           existing_id: id option;

     

       122
       122
       +
           max_recipients: uint option;

     

       123
       123
       +
           invalid_recipients: string list option;

     

       124
       124
       +
           max_size: uint option;

     

       125
       125
       +
           not_found_blob_ids: id list option;

     

       126
       126
       +
         }

     

       127
       127
       +
         

     

       128
       128
       +
         let type_ t = t.type_

     

       129
       129
       +
         let description t = t.description

     

       130
       130
       +
         let properties t = t.properties

     

       131
       131
       +
         let existing_id t = t.existing_id

     

       132
       132
       +
         let max_recipients t = t.max_recipients

     

       133
       133
       +
         let invalid_recipients t = t.invalid_recipients

     

       134
       134
       +
         let max_size t = t.max_size

     

       135
       135
       +
         let not_found_blob_ids t = t.not_found_blob_ids

     

       136
       136
       +
         

     

       137
       137
       +
         let v ?description ?properties ?existing_id ?max_recipients

     

       138
       138
       +
             ?invalid_recipients ?max_size ?not_found_blob_ids type_ =

     

       139
       139
       +
           { type_; description; properties; existing_id; max_recipients;

     

       140
       140
       +
             invalid_recipients; max_size; not_found_blob_ids }

     

       141
       141
       +
       end

     

       142
       142
       +
       

     

       143
       143
       +
       (* Error Handling Functions *)

     

       144
       144
       +
       

     

       145
       145
       +
       let transport_error msg = Transport msg

     

       146
       146
       +
       

     

       147
       147
       +
       let parse_error msg = Parse msg

     

       148
       148
       +
       

     

       149
       149
       +
       let protocol_error msg = Protocol msg

     

       150
       150
       +
       

     

       151
       151
       +
       let problem_error problem = 

     

       152
       152
       +
         Problem (Problem_details.problem_type problem)

     

       153
       153
       +
       

     

       154
       154
       +
       let method_error ?description type_ = 

     

       155
       155
       +
         Method (type_, description)

     

       156
       156
       +
       

     

       157
       157
       +
       let set_item_error id ?description type_ = 

     

       158
       158
       +
         SetItem (id, type_, description)

     

       159
       159
       +
       

     

       160
       160
       +
       let auth_error msg = Auth msg

     

       161
       161
       +
       

     

       162
       162
       +
       let server_error msg = ServerError msg

     

       163
       163
       +
       

     

       164
       164
       +
       let of_method_error method_error =

     

       165
       165
       +
         let description = match Method_error.description method_error with

     

       166
       166
       +
           | Some desc -> Method_error_description.description desc

     

       167
       167
       +
           | None -> None

     

       168
       168
       +
         in

     

       169
       169
       +
         Method (Method_error.type_ method_error, description)

     

       170
       170
       +
       

     

       171
       171
       +
       let of_set_error id set_error =

     

       172
       172
       +
         SetItem (id, Set_error.type_ set_error, Set_error.description set_error)

     

       173
       173
       +
       

     

       174
       174
       +
       let error_to_string = function

     

       175
       175
       +
         | Transport msg -> "Transport error: " ^ msg

     

       176
       176
       +
         | Parse msg -> "Parse error: " ^ msg

     

       177
       177
       +
         | Protocol msg -> "Protocol error: " ^ msg

     

       178
       178
       +
         | Problem problem -> "Problem: " ^ problem

     

       179
       179
       +
         | Method (type_, desc) -> 

     

       180
       180
       +
             let type_str = match type_ with

     

       181
       181
       +
               | `ServerUnavailable -> "serverUnavailable"

     

       182
       182
       +
               | `ServerFail -> "serverFail"

     

       183
       183
       +
               | `ServerPartialFail -> "serverPartialFail"

     

       184
       184
       +
               | `UnknownMethod -> "unknownMethod"

     

       185
       185
       +
               | `InvalidArguments -> "invalidArguments"

     

       186
       186
       +
               | `InvalidResultReference -> "invalidResultReference"

     

       187
       187
       +
               | `Forbidden -> "forbidden"

     

       188
       188
       +
               | `AccountNotFound -> "accountNotFound"

     

       189
       189
       +
               | `AccountNotSupportedByMethod -> "accountNotSupportedByMethod"

     

       190
       190
       +
               | `AccountReadOnly -> "accountReadOnly"

     

       191
       191
       +
               | `RequestTooLarge -> "requestTooLarge"

     

       192
       192
       +
               | `CannotCalculateChanges -> "cannotCalculateChanges"

     

       193
       193
       +
               | `StateMismatch -> "stateMismatch"

     

       194
       194
       +
               | `AnchorNotFound -> "anchorNotFound"

     

       195
       195
       +
               | `UnsupportedSort -> "unsupportedSort"

     

       196
       196
       +
               | `UnsupportedFilter -> "unsupportedFilter"

     

       197
       197
       +
               | `TooManyChanges -> "tooManyChanges"

     

       198
       198
       +
               | `FromAccountNotFound -> "fromAccountNotFound"

     

       199
       199
       +
               | `FromAccountNotSupportedByMethod -> "fromAccountNotSupportedByMethod"

     

       200
       200
       +
               | `Other_method_error s -> s

     

       201
       201
       +
             in

     

       202
       202
       +
             let desc_str = match desc with

     

       203
       203
       +
               | Some d -> ": " ^ d

     

       204
       204
       +
               | None -> ""

     

       205
       205
       +
             in

     

       206
       206
       +
             "Method error: " ^ type_str ^ desc_str

     

       207
       207
       +
         | SetItem (id, type_, desc) ->

     

       208
       208
       +
             let type_str = match type_ with

     

       209
       209
       +
               | `Forbidden -> "forbidden"

     

       210
       210
       +
               | `OverQuota -> "overQuota"

     

       211
       211
       +
               | `TooLarge -> "tooLarge"

     

       212
       212
       +
               | `RateLimit -> "rateLimit"

     

       213
       213
       +
               | `NotFound -> "notFound"

     

       214
       214
       +
               | `InvalidPatch -> "invalidPatch"

     

       215
       215
       +
               | `WillDestroy -> "willDestroy"

     

       216
       216
       +
               | `InvalidProperties -> "invalidProperties"

     

       217
       217
       +
               | `Singleton -> "singleton"

     

       218
       218
       +
               | `AlreadyExists -> "alreadyExists"

     

       219
       219
       +
               | `MailboxHasChild -> "mailboxHasChild"

     

       220
       220
       +
               | `MailboxHasEmail -> "mailboxHasEmail"

     

       221
       221
       +
               | `BlobNotFound -> "blobNotFound"

     

       222
       222
       +
               | `TooManyKeywords -> "tooManyKeywords"

     

       223
       223
       +
               | `TooManyMailboxes -> "tooManyMailboxes"

     

       224
       224
       +
               | `InvalidEmail -> "invalidEmail"

     

       225
       225
       +
               | `TooManyRecipients -> "tooManyRecipients"

     

       226
       226
       +
               | `NoRecipients -> "noRecipients"

     

       227
       227
       +
               | `InvalidRecipients -> "invalidRecipients"

     

       228
       228
       +
               | `ForbiddenMailFrom -> "forbiddenMailFrom"

     

       229
       229
       +
               | `ForbiddenFrom -> "forbiddenFrom"

     

       230
       230
       +
               | `ForbiddenToSend -> "forbiddenToSend"

     

       231
       231
       +
               | `CannotUnsend -> "cannotUnsend"

     

       232
       232
       +
               | `Other_set_error s -> s

     

       233
       233
       +
             in

     

       234
       234
       +
             let desc_str = match desc with

     

       235
       235
       +
               | Some d -> ": " ^ d

     

       236
       236
       +
               | None -> ""

     

       237
       237
       +
             in

     

       238
       238
       +
             "SetItem error for " ^ id ^ ": " ^ type_str ^ desc_str

     

       239
       239
       +
         | Auth msg -> "Authentication error: " ^ msg

     

       240
       240
       +
         | ServerError msg -> "Server error: " ^ msg

     

       241
       241
       +
       

     

       242
       242
       +
       (* Result Handling *)

     

       243
       243
       +
       

     

       244
       244
       +
       let map_error result f =

     

       245
       245
       +
         match result with

     

       246
       246
       +
         | Ok v -> Ok v

     

       247
       247
       +
         | Error e -> Error (f e)

     

       248
       248
       +
       

     

       249
       249
       +
       let with_context result context =

     

       250
       250
       +
         map_error result (function

     

       251
       251
       +
           | Transport msg -> Transport (context ^ ": " ^ msg)

     

       252
       252
       +
           | Parse msg -> Parse (context ^ ": " ^ msg)

     

       253
       253
       +
           | Protocol msg -> Protocol (context ^ ": " ^ msg)

     

       254
       254
       +
           | Problem p -> Problem (context ^ ": " ^ p)

     

       255
       255
       +
           | Method (t, Some d) -> Method (t, Some (context ^ ": " ^ d))

     

       256
       256
       +
           | Method (t, None) -> Method (t, Some context)

     

       257
       257
       +
           | SetItem (id, t, Some d) -> SetItem (id, t, Some (context ^ ": " ^ d))

     

       258
       258
       +
           | SetItem (id, t, None) -> SetItem (id, t, Some context)

     

       259
       259
       +
           | Auth msg -> Auth (context ^ ": " ^ msg)

     

       260
       260
       +
           | ServerError msg -> ServerError (context ^ ": " ^ msg)

     

       261
       261
       +
         )

     

       262
       262
       +
       

     

       263
       263
       +
       let of_option opt error =

     

       264
       264
       +
         match opt with

     

       265
       265
       +
         | Some v -> Ok v

     

       266
       266
       +
         | None -> Error error

+189

jmap/jmap_error.mli

···

       1
       1
       +
       (** JMAP Error Types.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       

     

       6
       6
       +
       (** Standard Method-level error types.

     

       7
       7
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       8
       8
       +
       type method_error_type = [

     

       9
       9
       +
         | `ServerUnavailable

     

       10
       10
       +
         | `ServerFail

     

       11
       11
       +
         | `ServerPartialFail

     

       12
       12
       +
         | `UnknownMethod

     

       13
       13
       +
         | `InvalidArguments

     

       14
       14
       +
         | `InvalidResultReference

     

       15
       15
       +
         | `Forbidden

     

       16
       16
       +
         | `AccountNotFound

     

       17
       17
       +
         | `AccountNotSupportedByMethod

     

       18
       18
       +
         | `AccountReadOnly

     

       19
       19
       +
         | `RequestTooLarge

     

       20
       20
       +
         | `CannotCalculateChanges

     

       21
       21
       +
         | `StateMismatch

     

       22
       22
       +
         | `AnchorNotFound

     

       23
       23
       +
         | `UnsupportedSort

     

       24
       24
       +
         | `UnsupportedFilter

     

       25
       25
       +
         | `TooManyChanges

     

       26
       26
       +
         | `FromAccountNotFound

     

       27
       27
       +
         | `FromAccountNotSupportedByMethod

     

       28
       28
       +
         | `Other_method_error of string

     

       29
       29
       +
       ]

     

       30
       30
       +
       

     

       31
       31
       +
       (** Standard SetError types.

     

       32
       32
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       33
       33
       +
       type set_error_type = [

     

       34
       34
       +
         | `Forbidden

     

       35
       35
       +
         | `OverQuota

     

       36
       36
       +
         | `TooLarge

     

       37
       37
       +
         | `RateLimit

     

       38
       38
       +
         | `NotFound

     

       39
       39
       +
         | `InvalidPatch

     

       40
       40
       +
         | `WillDestroy

     

       41
       41
       +
         | `InvalidProperties

     

       42
       42
       +
         | `Singleton

     

       43
       43
       +
         | `AlreadyExists (* From /copy *)

     

       44
       44
       +
         | `MailboxHasChild (* RFC 8621 *)

     

       45
       45
       +
         | `MailboxHasEmail (* RFC 8621 *)

     

       46
       46
       +
         | `BlobNotFound (* RFC 8621 *)

     

       47
       47
       +
         | `TooManyKeywords (* RFC 8621 *)

     

       48
       48
       +
         | `TooManyMailboxes (* RFC 8621 *)

     

       49
       49
       +
         | `InvalidEmail (* RFC 8621 *)

     

       50
       50
       +
         | `TooManyRecipients (* RFC 8621 *)

     

       51
       51
       +
         | `NoRecipients (* RFC 8621 *)

     

       52
       52
       +
         | `InvalidRecipients (* RFC 8621 *)

     

       53
       53
       +
         | `ForbiddenMailFrom (* RFC 8621 *)

     

       54
       54
       +
         | `ForbiddenFrom (* RFC 8621 *)

     

       55
       55
       +
         | `ForbiddenToSend (* RFC 8621 *)

     

       56
       56
       +
         | `CannotUnsend (* RFC 8621 *)

     

       57
       57
       +
         | `Other_set_error of string (* For future or custom errors *)

     

       58
       58
       +
       ]

     

       59
       59
       +
       

     

       60
       60
       +
       (** Primary error type that can represent all JMAP errors *)

     

       61
       61
       +
       type error =

     

       62
       62
       +
         | Transport of string     (** Network/HTTP-level error *)

     

       63
       63
       +
         | Parse of string         (** JSON parsing error *)

     

       64
       64
       +
         | Protocol of string      (** JMAP protocol error *)

     

       65
       65
       +
         | Problem of string       (** Problem Details object error *)

     

       66
       66
       +
         | Method of method_error_type * string option (** Method error with optional description *)

     

       67
       67
       +
         | SetItem of id * set_error_type * string option (** Error for a specific item in a /set operation *)

     

       68
       68
       +
         | Auth of string          (** Authentication error *)

     

       69
       69
       +
         | ServerError of string   (** Server reported an error *)

     

       70
       70
       +
       

     

       71
       71
       +
       (** Standard Result type for JMAP operations *)

     

       72
       72
       +
       type 'a result = ('a, error) Result.t

     

       73
       73
       +
       

     

       74
       74
       +
       (** Problem details object for HTTP-level errors.

     

       75
       75
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.1> RFC 8620, Section 3.6.1

     

       76
       76
       +
           @see <https://www.rfc-editor.org/rfc/rfc7807.html> RFC 7807 *)

     

       77
       77
       +
       module Problem_details : sig

     

       78
       78
       +
         type t

     

       79
       79
       +
       

     

       80
       80
       +
         val problem_type : t -> string

     

       81
       81
       +
         val status : t -> int option

     

       82
       82
       +
         val detail : t -> string option

     

       83
       83
       +
         val limit : t -> string option

     

       84
       84
       +
         val other_fields : t -> Yojson.Safe.t string_map

     

       85
       85
       +
         

     

       86
       86
       +
         val v : 

     

       87
       87
       +
           ?status:int ->

     

       88
       88
       +
           ?detail:string ->

     

       89
       89
       +
           ?limit:string ->

     

       90
       90
       +
           ?other_fields:Yojson.Safe.t string_map ->

     

       91
       91
       +
           string ->

     

       92
       92
       +
           t

     

       93
       93
       +
       end

     

       94
       94
       +
       

     

       95
       95
       +
       (** Description for method errors. May contain additional details.

     

       96
       96
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       97
       97
       +
       module Method_error_description : sig

     

       98
       98
       +
         type t

     

       99
       99
       +
         

     

       100
       100
       +
         val description : t -> string option

     

       101
       101
       +
         

     

       102
       102
       +
         val v : ?description:string -> unit -> t

     

       103
       103
       +
       end

     

       104
       104
       +
       

     

       105
       105
       +
       (** Represents a method-level error response invocation part.

     

       106
       106
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       107
       107
       +
       module Method_error : sig

     

       108
       108
       +
         type t

     

       109
       109
       +
         

     

       110
       110
       +
         val type_ : t -> method_error_type

     

       111
       111
       +
         val description : t -> Method_error_description.t option

     

       112
       112
       +
         

     

       113
       113
       +
         val v : 

     

       114
       114
       +
           ?description:Method_error_description.t ->

     

       115
       115
       +
           method_error_type ->

     

       116
       116
       +
           t

     

       117
       117
       +
       end

     

       118
       118
       +
       

     

       119
       119
       +
       (** SetError object.

     

       120
       120
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       121
       121
       +
       module Set_error : sig

     

       122
       122
       +
         type t

     

       123
       123
       +
         

     

       124
       124
       +
         val type_ : t -> set_error_type

     

       125
       125
       +
         val description : t -> string option

     

       126
       126
       +
         val properties : t -> string list option

     

       127
       127
       +
         val existing_id : t -> id option

     

       128
       128
       +
         val max_recipients : t -> uint option

     

       129
       129
       +
         val invalid_recipients : t -> string list option

     

       130
       130
       +
         val max_size : t -> uint option

     

       131
       131
       +
         val not_found_blob_ids : t -> id list option

     

       132
       132
       +
         

     

       133
       133
       +
         val v :

     

       134
       134
       +
           ?description:string ->

     

       135
       135
       +
           ?properties:string list ->

     

       136
       136
       +
           ?existing_id:id ->

     

       137
       137
       +
           ?max_recipients:uint ->

     

       138
       138
       +
           ?invalid_recipients:string list ->

     

       139
       139
       +
           ?max_size:uint ->

     

       140
       140
       +
           ?not_found_blob_ids:id list ->

     

       141
       141
       +
           set_error_type ->

     

       142
       142
       +
           t

     

       143
       143
       +
       end

     

       144
       144
       +
       

     

       145
       145
       +
       (** {2 Error Handling Functions} *)

     

       146
       146
       +
       

     

       147
       147
       +
       (** Create a transport error *)

     

       148
       148
       +
       val transport_error : string -> error

     

       149
       149
       +
       

     

       150
       150
       +
       (** Create a parse error *)

     

       151
       151
       +
       val parse_error : string -> error

     

       152
       152
       +
       

     

       153
       153
       +
       (** Create a protocol error *)

     

       154
       154
       +
       val protocol_error : string -> error 

     

       155
       155
       +
       

     

       156
       156
       +
       (** Create a problem details error *)

     

       157
       157
       +
       val problem_error : Problem_details.t -> error

     

       158
       158
       +
       

     

       159
       159
       +
       (** Create a method error *)

     

       160
       160
       +
       val method_error : ?description:string -> method_error_type -> error

     

       161
       161
       +
       

     

       162
       162
       +
       (** Create a SetItem error *)

     

       163
       163
       +
       val set_item_error : id -> ?description:string -> set_error_type -> error

     

       164
       164
       +
       

     

       165
       165
       +
       (** Create an auth error *)

     

       166
       166
       +
       val auth_error : string -> error

     

       167
       167
       +
       

     

       168
       168
       +
       (** Create a server error *)

     

       169
       169
       +
       val server_error : string -> error

     

       170
       170
       +
       

     

       171
       171
       +
       (** Convert a Method_error.t to error *)

     

       172
       172
       +
       val of_method_error : Method_error.t -> error

     

       173
       173
       +
       

     

       174
       174
       +
       (** Convert a Set_error.t to error for a specific ID *)

     

       175
       175
       +
       val of_set_error : id -> Set_error.t -> error

     

       176
       176
       +
       

     

       177
       177
       +
       (** Get a human-readable description of an error *)

     

       178
       178
       +
       val error_to_string : error -> string

     

       179
       179
       +
       

     

       180
       180
       +
       (** {2 Result Handling} *)

     

       181
       181
       +
       

     

       182
       182
       +
       (** Map an error with additional context *)

     

       183
       183
       +
       val map_error : 'a result -> (error -> error) -> 'a result

     

       184
       184
       +
       

     

       185
       185
       +
       (** Add context to an error *)

     

       186
       186
       +
       val with_context : 'a result -> string -> 'a result

     

       187
       187
       +
       

     

       188
       188
       +
       (** Convert an option to a result with an error for None *)

     

       189
       189
       +
       val of_option : 'a option -> error -> 'a result

+436

jmap/jmap_methods.ml

···

       1
       1
       +
       (* Standard JMAP Methods and Core/echo. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       open Jmap_error

     

       5
       5
       +
       

     

       6
       6
       +
       (* Generic representation of a record type. Actual types defined elsewhere. *)

     

       7
       7
       +
       type generic_record = Yojson.Safe.t

     

       8
       8
       +
       

     

       9
       9
       +
       (* Arguments for /get methods. *)

     

       10
       10
       +
       module Get_args = struct

     

       11
       11
       +
         type 'record t = {

     

       12
       12
       +
           account_id: id;

     

       13
       13
       +
           ids: id list option;

     

       14
       14
       +
           properties: string list option;

     

       15
       15
       +
         }

     

       16
       16
       +
         

     

       17
       17
       +
         let account_id t = t.account_id

     

       18
       18
       +
         let ids t = t.ids

     

       19
       19
       +
         let properties t = t.properties

     

       20
       20
       +
         

     

       21
       21
       +
         let v ~account_id ?ids ?properties () =

     

       22
       22
       +
           { account_id; ids; properties }

     

       23
       23
       +
       end

     

       24
       24
       +
       

     

       25
       25
       +
       (* Response for /get methods. *)

     

       26
       26
       +
       module Get_response = struct

     

       27
       27
       +
         type 'record t = {

     

       28
       28
       +
           account_id: id;

     

       29
       29
       +
           state: string;

     

       30
       30
       +
           list: 'record list;

     

       31
       31
       +
           not_found: id list;

     

       32
       32
       +
         }

     

       33
       33
       +
         

     

       34
       34
       +
         let account_id t = t.account_id

     

       35
       35
       +
         let state t = t.state

     

       36
       36
       +
         let list t = t.list

     

       37
       37
       +
         let not_found t = t.not_found

     

       38
       38
       +
         

     

       39
       39
       +
         let v ~account_id ~state ~list ~not_found () =

     

       40
       40
       +
           { account_id; state; list; not_found }

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (* Arguments for /changes methods. *)

     

       44
       44
       +
       module Changes_args = struct

     

       45
       45
       +
         type t = {

     

       46
       46
       +
           account_id: id;

     

       47
       47
       +
           since_state: string;

     

       48
       48
       +
           max_changes: uint option;

     

       49
       49
       +
         }

     

       50
       50
       +
         

     

       51
       51
       +
         let account_id t = t.account_id

     

       52
       52
       +
         let since_state t = t.since_state

     

       53
       53
       +
         let max_changes t = t.max_changes

     

       54
       54
       +
         

     

       55
       55
       +
         let v ~account_id ~since_state ?max_changes () =

     

       56
       56
       +
           { account_id; since_state; max_changes }

     

       57
       57
       +
       end

     

       58
       58
       +
       

     

       59
       59
       +
       (* Response for /changes methods. *)

     

       60
       60
       +
       module Changes_response = struct

     

       61
       61
       +
         type t = {

     

       62
       62
       +
           account_id: id;

     

       63
       63
       +
           old_state: string;

     

       64
       64
       +
           new_state: string;

     

       65
       65
       +
           has_more_changes: bool;

     

       66
       66
       +
           created: id list;

     

       67
       67
       +
           updated: id list;

     

       68
       68
       +
           destroyed: id list;

     

       69
       69
       +
           updated_properties: string list option;

     

       70
       70
       +
         }

     

       71
       71
       +
         

     

       72
       72
       +
         let account_id t = t.account_id

     

       73
       73
       +
         let old_state t = t.old_state

     

       74
       74
       +
         let new_state t = t.new_state

     

       75
       75
       +
         let has_more_changes t = t.has_more_changes

     

       76
       76
       +
         let created t = t.created

     

       77
       77
       +
         let updated t = t.updated

     

       78
       78
       +
         let destroyed t = t.destroyed

     

       79
       79
       +
         let updated_properties t = t.updated_properties

     

       80
       80
       +
         

     

       81
       81
       +
         let v ~account_id ~old_state ~new_state ~has_more_changes

     

       82
       82
       +
             ~created ~updated ~destroyed ?updated_properties () =

     

       83
       83
       +
           { account_id; old_state; new_state; has_more_changes;

     

       84
       84
       +
             created; updated; destroyed; updated_properties }

     

       85
       85
       +
       end

     

       86
       86
       +
       

     

       87
       87
       +
       (* Patch object for /set update.

     

       88
       88
       +
          A list of (JSON Pointer path, value) pairs. *)

     

       89
       89
       +
       type patch_object = (json_pointer * Yojson.Safe.t) list

     

       90
       90
       +
       

     

       91
       91
       +
       (* Arguments for /set methods. *)

     

       92
       92
       +
       module Set_args = struct

     

       93
       93
       +
         type ('create_record, 'update_record) t = {

     

       94
       94
       +
           account_id: id;

     

       95
       95
       +
           if_in_state: string option;

     

       96
       96
       +
           create: 'create_record id_map option;

     

       97
       97
       +
           update: 'update_record id_map option;

     

       98
       98
       +
           destroy: id list option;

     

       99
       99
       +
           on_success_destroy_original: bool option;

     

       100
       100
       +
           destroy_from_if_in_state: string option;

     

       101
       101
       +
           on_destroy_remove_emails: bool option;

     

       102
       102
       +
         }

     

       103
       103
       +
         

     

       104
       104
       +
         let account_id t = t.account_id

     

       105
       105
       +
         let if_in_state t = t.if_in_state

     

       106
       106
       +
         let create t = t.create

     

       107
       107
       +
         let update t = t.update

     

       108
       108
       +
         let destroy t = t.destroy

     

       109
       109
       +
         let on_success_destroy_original t = t.on_success_destroy_original

     

       110
       110
       +
         let destroy_from_if_in_state t = t.destroy_from_if_in_state

     

       111
       111
       +
         let on_destroy_remove_emails t = t.on_destroy_remove_emails

     

       112
       112
       +
         

     

       113
       113
       +
         let v ~account_id ?if_in_state ?create ?update ?destroy

     

       114
       114
       +
             ?on_success_destroy_original ?destroy_from_if_in_state

     

       115
       115
       +
             ?on_destroy_remove_emails () =

     

       116
       116
       +
           { account_id; if_in_state; create; update; destroy;

     

       117
       117
       +
             on_success_destroy_original; destroy_from_if_in_state;

     

       118
       118
       +
             on_destroy_remove_emails }

     

       119
       119
       +
       end

     

       120
       120
       +
       

     

       121
       121
       +
       (* Response for /set methods. *)

     

       122
       122
       +
       module Set_response = struct

     

       123
       123
       +
         type ('created_record_info, 'updated_record_info) t = {

     

       124
       124
       +
           account_id: id;

     

       125
       125
       +
           old_state: string option;

     

       126
       126
       +
           new_state: string;

     

       127
       127
       +
           created: 'created_record_info id_map option;

     

       128
       128
       +
           updated: 'updated_record_info option id_map option;

     

       129
       129
       +
           destroyed: id list option;

     

       130
       130
       +
           not_created: Set_error.t id_map option;

     

       131
       131
       +
           not_updated: Set_error.t id_map option;

     

       132
       132
       +
           not_destroyed: Set_error.t id_map option;

     

       133
       133
       +
         }

     

       134
       134
       +
         

     

       135
       135
       +
         let account_id t = t.account_id

     

       136
       136
       +
         let old_state t = t.old_state

     

       137
       137
       +
         let new_state t = t.new_state

     

       138
       138
       +
         let created t = t.created

     

       139
       139
       +
         let updated t = t.updated

     

       140
       140
       +
         let destroyed t = t.destroyed

     

       141
       141
       +
         let not_created t = t.not_created

     

       142
       142
       +
         let not_updated t = t.not_updated

     

       143
       143
       +
         let not_destroyed t = t.not_destroyed

     

       144
       144
       +
         

     

       145
       145
       +
         let v ~account_id ?old_state ~new_state ?created ?updated ?destroyed

     

       146
       146
       +
             ?not_created ?not_updated ?not_destroyed () =

     

       147
       147
       +
           { account_id; old_state; new_state; created; updated; destroyed;

     

       148
       148
       +
             not_created; not_updated; not_destroyed }

     

       149
       149
       +
       end

     

       150
       150
       +
       

     

       151
       151
       +
       (* Arguments for /copy methods. *)

     

       152
       152
       +
       module Copy_args = struct

     

       153
       153
       +
         type 'copy_record_override t = {

     

       154
       154
       +
           from_account_id: id;

     

       155
       155
       +
           if_from_in_state: string option;

     

       156
       156
       +
           account_id: id;

     

       157
       157
       +
           if_in_state: string option;

     

       158
       158
       +
           create: 'copy_record_override id_map;

     

       159
       159
       +
           on_success_destroy_original: bool;

     

       160
       160
       +
           destroy_from_if_in_state: string option;

     

       161
       161
       +
         }

     

       162
       162
       +
         

     

       163
       163
       +
         let from_account_id t = t.from_account_id

     

       164
       164
       +
         let if_from_in_state t = t.if_from_in_state

     

       165
       165
       +
         let account_id t = t.account_id

     

       166
       166
       +
         let if_in_state t = t.if_in_state

     

       167
       167
       +
         let create t = t.create

     

       168
       168
       +
         let on_success_destroy_original t = t.on_success_destroy_original

     

       169
       169
       +
         let destroy_from_if_in_state t = t.destroy_from_if_in_state

     

       170
       170
       +
         

     

       171
       171
       +
         let v ~from_account_id ?if_from_in_state ~account_id ?if_in_state

     

       172
       172
       +
             ~create ?(on_success_destroy_original=false) ?destroy_from_if_in_state () =

     

       173
       173
       +
           { from_account_id; if_from_in_state; account_id; if_in_state;

     

       174
       174
       +
             create; on_success_destroy_original; destroy_from_if_in_state }

     

       175
       175
       +
       end

     

       176
       176
       +
       

     

       177
       177
       +
       (* Response for /copy methods. *)

     

       178
       178
       +
       module Copy_response = struct

     

       179
       179
       +
         type 'created_record_info t = {

     

       180
       180
       +
           from_account_id: id;

     

       181
       181
       +
           account_id: id;

     

       182
       182
       +
           old_state: string option;

     

       183
       183
       +
           new_state: string;

     

       184
       184
       +
           created: 'created_record_info id_map option;

     

       185
       185
       +
           not_created: Set_error.t id_map option;

     

       186
       186
       +
         }

     

       187
       187
       +
         

     

       188
       188
       +
         let from_account_id t = t.from_account_id

     

       189
       189
       +
         let account_id t = t.account_id

     

       190
       190
       +
         let old_state t = t.old_state

     

       191
       191
       +
         let new_state t = t.new_state

     

       192
       192
       +
         let created t = t.created

     

       193
       193
       +
         let not_created t = t.not_created

     

       194
       194
       +
         

     

       195
       195
       +
         let v ~from_account_id ~account_id ?old_state ~new_state

     

       196
       196
       +
             ?created ?not_created () =

     

       197
       197
       +
           { from_account_id; account_id; old_state; new_state;

     

       198
       198
       +
             created; not_created }

     

       199
       199
       +
       end

     

       200
       200
       +
       

     

       201
       201
       +
       (* Module for generic filter representation. *)

     

       202
       202
       +
       module Filter = struct

     

       203
       203
       +
         type t =

     

       204
       204
       +
           | Condition of Yojson.Safe.t

     

       205
       205
       +
           | Operator of [ `AND | `OR | `NOT ] * t list

     

       206
       206
       +
         

     

       207
       207
       +
         let condition json = Condition json

     

       208
       208
       +
         

     

       209
       209
       +
         let operator op filters = Operator (op, filters)

     

       210
       210
       +
         

     

       211
       211
       +
         let and_ filters = operator `AND filters

     

       212
       212
       +
         

     

       213
       213
       +
         let or_ filters = operator `OR filters

     

       214
       214
       +
         

     

       215
       215
       +
         let not_ filter = operator `NOT [filter]

     

       216
       216
       +
         

     

       217
       217
       +
         let rec to_json = function

     

       218
       218
       +
           | Condition json -> json

     

       219
       219
       +
           | Operator (op, filters) ->

     

       220
       220
       +
               let key = match op with

     

       221
       221
       +
                 | `AND -> "AND"

     

       222
       222
       +
                 | `OR -> "OR"

     

       223
       223
       +
                 | `NOT -> "NOT"

     

       224
       224
       +
               in

     

       225
       225
       +
               `Assoc [(key, `List (List.map to_json filters))]

     

       226
       226
       +
         

     

       227
       227
       +
         (* Helper functions for common filter conditions *)

     

       228
       228
       +
         

     

       229
       229
       +
         let text_contains property value =

     

       230
       230
       +
           condition (`Assoc [

     

       231
       231
       +
             (property, `Assoc [("contains", `String value)])

     

       232
       232
       +
           ])

     

       233
       233
       +
         

     

       234
       234
       +
         let property_equals property value =

     

       235
       235
       +
           condition (`Assoc [(property, value)])

     

       236
       236
       +
         

     

       237
       237
       +
         let property_not_equals property value =

     

       238
       238
       +
           condition (`Assoc [

     

       239
       239
       +
             (property, `Assoc [("!",value)])

     

       240
       240
       +
           ])

     

       241
       241
       +
         

     

       242
       242
       +
         let property_gt property value =

     

       243
       243
       +
           condition (`Assoc [

     

       244
       244
       +
             (property, `Assoc [("gt", value)])

     

       245
       245
       +
           ])

     

       246
       246
       +
         

     

       247
       247
       +
         let property_ge property value =

     

       248
       248
       +
           condition (`Assoc [

     

       249
       249
       +
             (property, `Assoc [("ge", value)])

     

       250
       250
       +
           ])

     

       251
       251
       +
         

     

       252
       252
       +
         let property_lt property value =

     

       253
       253
       +
           condition (`Assoc [

     

       254
       254
       +
             (property, `Assoc [("lt", value)])

     

       255
       255
       +
           ])

     

       256
       256
       +
         

     

       257
       257
       +
         let property_le property value =

     

       258
       258
       +
           condition (`Assoc [

     

       259
       259
       +
             (property, `Assoc [("le", value)])

     

       260
       260
       +
           ])

     

       261
       261
       +
         

     

       262
       262
       +
         let property_in property values =

     

       263
       263
       +
           condition (`Assoc [

     

       264
       264
       +
             (property, `Assoc [("in", `List values)])

     

       265
       265
       +
           ])

     

       266
       266
       +
         

     

       267
       267
       +
         let property_not_in property values =

     

       268
       268
       +
           condition (`Assoc [

     

       269
       269
       +
             (property, `Assoc [("!in", `List values)])

     

       270
       270
       +
           ])

     

       271
       271
       +
         

     

       272
       272
       +
         let property_exists property =

     

       273
       273
       +
           condition (`Assoc [

     

       274
       274
       +
             (property, `Null) (* Using just the property name means "property exists" *)

     

       275
       275
       +
           ])

     

       276
       276
       +
         

     

       277
       277
       +
         let string_starts_with property prefix =

     

       278
       278
       +
           condition (`Assoc [

     

       279
       279
       +
             (property, `Assoc [("startsWith", `String prefix)])

     

       280
       280
       +
           ])

     

       281
       281
       +
         

     

       282
       282
       +
         let string_ends_with property suffix =

     

       283
       283
       +
           condition (`Assoc [

     

       284
       284
       +
             (property, `Assoc [("endsWith", `String suffix)])

     

       285
       285
       +
           ])

     

       286
       286
       +
       end

     

       287
       287
       +
       

     

       288
       288
       +
       (* Comparator for sorting. *)

     

       289
       289
       +
       module Comparator = struct

     

       290
       290
       +
         type t = {

     

       291
       291
       +
           property: string;

     

       292
       292
       +
           is_ascending: bool option;

     

       293
       293
       +
           collation: string option;

     

       294
       294
       +
           keyword: string option;

     

       295
       295
       +
           other_fields: Yojson.Safe.t string_map;

     

       296
       296
       +
         }

     

       297
       297
       +
         

     

       298
       298
       +
         let property t = t.property

     

       299
       299
       +
         let is_ascending t = t.is_ascending

     

       300
       300
       +
         let collation t = t.collation

     

       301
       301
       +
         let keyword t = t.keyword

     

       302
       302
       +
         let other_fields t = t.other_fields

     

       303
       303
       +
         

     

       304
       304
       +
         let v ~property ?is_ascending ?collation ?keyword

     

       305
       305
       +
             ?(other_fields=Hashtbl.create 0) () =

     

       306
       306
       +
           { property; is_ascending; collation; keyword; other_fields }

     

       307
       307
       +
       end

     

       308
       308
       +
       

     

       309
       309
       +
       (* Arguments for /query methods. *)

     

       310
       310
       +
       module Query_args = struct

     

       311
       311
       +
         type t = {

     

       312
       312
       +
           account_id: id;

     

       313
       313
       +
           filter: Filter.t option;

     

       314
       314
       +
           sort: Comparator.t list option;

     

       315
       315
       +
           position: jint option;

     

       316
       316
       +
           anchor: id option;

     

       317
       317
       +
           anchor_offset: jint option;

     

       318
       318
       +
           limit: uint option;

     

       319
       319
       +
           calculate_total: bool option;

     

       320
       320
       +
           collapse_threads: bool option;

     

       321
       321
       +
           sort_as_tree: bool option;

     

       322
       322
       +
           filter_as_tree: bool option;

     

       323
       323
       +
         }

     

       324
       324
       +
         

     

       325
       325
       +
         let account_id t = t.account_id

     

       326
       326
       +
         let filter t = t.filter

     

       327
       327
       +
         let sort t = t.sort

     

       328
       328
       +
         let position t = t.position

     

       329
       329
       +
         let anchor t = t.anchor

     

       330
       330
       +
         let anchor_offset t = t.anchor_offset

     

       331
       331
       +
         let limit t = t.limit

     

       332
       332
       +
         let calculate_total t = t.calculate_total

     

       333
       333
       +
         let collapse_threads t = t.collapse_threads

     

       334
       334
       +
         let sort_as_tree t = t.sort_as_tree

     

       335
       335
       +
         let filter_as_tree t = t.filter_as_tree

     

       336
       336
       +
         

     

       337
       337
       +
         let v ~account_id ?filter ?sort ?position ?anchor ?anchor_offset

     

       338
       338
       +
             ?limit ?calculate_total ?collapse_threads ?sort_as_tree ?filter_as_tree () =

     

       339
       339
       +
           { account_id; filter; sort; position; anchor; anchor_offset;

     

       340
       340
       +
             limit; calculate_total; collapse_threads; sort_as_tree; filter_as_tree }

     

       341
       341
       +
       end

     

       342
       342
       +
       

     

       343
       343
       +
       (* Response for /query methods. *)

     

       344
       344
       +
       module Query_response = struct

     

       345
       345
       +
         type t = {

     

       346
       346
       +
           account_id: id;

     

       347
       347
       +
           query_state: string;

     

       348
       348
       +
           can_calculate_changes: bool;

     

       349
       349
       +
           position: uint;

     

       350
       350
       +
           ids: id list;

     

       351
       351
       +
           total: uint option;

     

       352
       352
       +
           limit: uint option;

     

       353
       353
       +
         }

     

       354
       354
       +
         

     

       355
       355
       +
         let account_id t = t.account_id

     

       356
       356
       +
         let query_state t = t.query_state

     

       357
       357
       +
         let can_calculate_changes t = t.can_calculate_changes

     

       358
       358
       +
         let position t = t.position

     

       359
       359
       +
         let ids t = t.ids

     

       360
       360
       +
         let total t = t.total

     

       361
       361
       +
         let limit t = t.limit

     

       362
       362
       +
         

     

       363
       363
       +
         let v ~account_id ~query_state ~can_calculate_changes ~position ~ids

     

       364
       364
       +
             ?total ?limit () =

     

       365
       365
       +
           { account_id; query_state; can_calculate_changes; position; ids;

     

       366
       366
       +
             total; limit }

     

       367
       367
       +
       end

     

       368
       368
       +
       

     

       369
       369
       +
       (* Item indicating an added record in /queryChanges. *)

     

       370
       370
       +
       module Added_item = struct

     

       371
       371
       +
         type t = {

     

       372
       372
       +
           id: id;

     

       373
       373
       +
           index: uint;

     

       374
       374
       +
         }

     

       375
       375
       +
         

     

       376
       376
       +
         let id t = t.id

     

       377
       377
       +
         let index t = t.index

     

       378
       378
       +
         

     

       379
       379
       +
         let v ~id ~index () = { id; index }

     

       380
       380
       +
       end

     

       381
       381
       +
       

     

       382
       382
       +
       (* Arguments for /queryChanges methods. *)

     

       383
       383
       +
       module Query_changes_args = struct

     

       384
       384
       +
         type t = {

     

       385
       385
       +
           account_id: id;

     

       386
       386
       +
           filter: Filter.t option;

     

       387
       387
       +
           sort: Comparator.t list option;

     

       388
       388
       +
           since_query_state: string;

     

       389
       389
       +
           max_changes: uint option;

     

       390
       390
       +
           up_to_id: id option;

     

       391
       391
       +
           calculate_total: bool option;

     

       392
       392
       +
           collapse_threads: bool option;

     

       393
       393
       +
         }

     

       394
       394
       +
         

     

       395
       395
       +
         let account_id t = t.account_id

     

       396
       396
       +
         let filter t = t.filter

     

       397
       397
       +
         let sort t = t.sort

     

       398
       398
       +
         let since_query_state t = t.since_query_state

     

       399
       399
       +
         let max_changes t = t.max_changes

     

       400
       400
       +
         let up_to_id t = t.up_to_id

     

       401
       401
       +
         let calculate_total t = t.calculate_total

     

       402
       402
       +
         let collapse_threads t = t.collapse_threads

     

       403
       403
       +
         

     

       404
       404
       +
         let v ~account_id ?filter ?sort ~since_query_state ?max_changes

     

       405
       405
       +
             ?up_to_id ?calculate_total ?collapse_threads () =

     

       406
       406
       +
           { account_id; filter; sort; since_query_state; max_changes;

     

       407
       407
       +
             up_to_id; calculate_total; collapse_threads }

     

       408
       408
       +
       end

     

       409
       409
       +
       

     

       410
       410
       +
       (* Response for /queryChanges methods. *)

     

       411
       411
       +
       module Query_changes_response = struct

     

       412
       412
       +
         type t = {

     

       413
       413
       +
           account_id: id;

     

       414
       414
       +
           old_query_state: string;

     

       415
       415
       +
           new_query_state: string;

     

       416
       416
       +
           total: uint option;

     

       417
       417
       +
           removed: id list;

     

       418
       418
       +
           added: Added_item.t list;

     

       419
       419
       +
         }

     

       420
       420
       +
         

     

       421
       421
       +
         let account_id t = t.account_id

     

       422
       422
       +
         let old_query_state t = t.old_query_state

     

       423
       423
       +
         let new_query_state t = t.new_query_state

     

       424
       424
       +
         let total t = t.total

     

       425
       425
       +
         let removed t = t.removed

     

       426
       426
       +
         let added t = t.added

     

       427
       427
       +
         

     

       428
       428
       +
         let v ~account_id ~old_query_state ~new_query_state ?total

     

       429
       429
       +
             ~removed ~added () =

     

       430
       430
       +
           { account_id; old_query_state; new_query_state; total;

     

       431
       431
       +
             removed; added }

     

       432
       432
       +
       end

     

       433
       433
       +
       

     

       434
       434
       +
       (* Core/echo method: Arguments are mirrored in the response. *)

     

       435
       435
       +
       type core_echo_args = Yojson.Safe.t

     

       436
       436
       +
       type core_echo_response = Yojson.Safe.t

+417

jmap/jmap_methods.mli

···

       1
       1
       +
       (** Standard JMAP Methods and Core/echo.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4

     

       3
       3
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 *)

     

       4
       4
       +
       

     

       5
       5
       +
       open Jmap_types

     

       6
       6
       +
       open Jmap_error

     

       7
       7
       +
       

     

       8
       8
       +
       (** Generic representation of a record type. Actual types defined elsewhere. *)

     

       9
       9
       +
       type generic_record

     

       10
       10
       +
       

     

       11
       11
       +
       (** Arguments for /get methods.

     

       12
       12
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)

     

       13
       13
       +
       module Get_args : sig

     

       14
       14
       +
         type 'record t

     

       15
       15
       +
         

     

       16
       16
       +
         val account_id : 'record t -> id

     

       17
       17
       +
         val ids : 'record t -> id list option

     

       18
       18
       +
         val properties : 'record t -> string list option

     

       19
       19
       +
         

     

       20
       20
       +
         val v :

     

       21
       21
       +
           account_id:id ->

     

       22
       22
       +
           ?ids:id list ->

     

       23
       23
       +
           ?properties:string list ->

     

       24
       24
       +
           unit ->

     

       25
       25
       +
           'record t

     

       26
       26
       +
       end

     

       27
       27
       +
       

     

       28
       28
       +
       (** Response for /get methods.

     

       29
       29
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)

     

       30
       30
       +
       module Get_response : sig

     

       31
       31
       +
         type 'record t

     

       32
       32
       +
         

     

       33
       33
       +
         val account_id : 'record t -> id

     

       34
       34
       +
         val state : 'record t -> string

     

       35
       35
       +
         val list : 'record t -> 'record list

     

       36
       36
       +
         val not_found : 'record t -> id list

     

       37
       37
       +
         

     

       38
       38
       +
         val v :

     

       39
       39
       +
           account_id:id ->

     

       40
       40
       +
           state:string ->

     

       41
       41
       +
           list:'record list ->

     

       42
       42
       +
           not_found:id list ->

     

       43
       43
       +
           unit ->

     

       44
       44
       +
           'record t

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (** Arguments for /changes methods.

     

       48
       48
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)

     

       49
       49
       +
       module Changes_args : sig

     

       50
       50
       +
         type t

     

       51
       51
       +
         

     

       52
       52
       +
         val account_id : t -> id

     

       53
       53
       +
         val since_state : t -> string

     

       54
       54
       +
         val max_changes : t -> uint option

     

       55
       55
       +
         

     

       56
       56
       +
         val v :

     

       57
       57
       +
           account_id:id ->

     

       58
       58
       +
           since_state:string ->

     

       59
       59
       +
           ?max_changes:uint ->

     

       60
       60
       +
           unit ->

     

       61
       61
       +
           t

     

       62
       62
       +
       end

     

       63
       63
       +
       

     

       64
       64
       +
       (** Response for /changes methods.

     

       65
       65
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)

     

       66
       66
       +
       module Changes_response : sig

     

       67
       67
       +
         type t

     

       68
       68
       +
         

     

       69
       69
       +
         val account_id : t -> id

     

       70
       70
       +
         val old_state : t -> string

     

       71
       71
       +
         val new_state : t -> string

     

       72
       72
       +
         val has_more_changes : t -> bool

     

       73
       73
       +
         val created : t -> id list

     

       74
       74
       +
         val updated : t -> id list

     

       75
       75
       +
         val destroyed : t -> id list

     

       76
       76
       +
         val updated_properties : t -> string list option

     

       77
       77
       +
         

     

       78
       78
       +
         val v :

     

       79
       79
       +
           account_id:id ->

     

       80
       80
       +
           old_state:string ->

     

       81
       81
       +
           new_state:string ->

     

       82
       82
       +
           has_more_changes:bool ->

     

       83
       83
       +
           created:id list ->

     

       84
       84
       +
           updated:id list ->

     

       85
       85
       +
           destroyed:id list ->

     

       86
       86
       +
           ?updated_properties:string list ->

     

       87
       87
       +
           unit ->

     

       88
       88
       +
           t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** Patch object for /set update.

     

       92
       92
       +
           A list of (JSON Pointer path, value) pairs.

     

       93
       93
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       94
       94
       +
       type patch_object = (json_pointer * Yojson.Safe.t) list

     

       95
       95
       +
       

     

       96
       96
       +
       (** Arguments for /set methods.

     

       97
       97
       +
           ['create_record] is the record type without server-set/immutable fields.

     

       98
       98
       +
           ['update_record] is the patch object type (usually [patch_object]).

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       100
       100
       +
       module Set_args : sig

     

       101
       101
       +
         type ('create_record, 'update_record) t

     

       102
       102
       +
         

     

       103
       103
       +
         val account_id : ('a, 'b) t -> id

     

       104
       104
       +
         val if_in_state : ('a, 'b) t -> string option

     

       105
       105
       +
         val create : ('a, 'b) t -> 'a id_map option

     

       106
       106
       +
         val update : ('a, 'b) t -> 'b id_map option

     

       107
       107
       +
         val destroy : ('a, 'b) t -> id list option

     

       108
       108
       +
         val on_success_destroy_original : ('a, 'b) t -> bool option

     

       109
       109
       +
         val destroy_from_if_in_state : ('a, 'b) t -> string option

     

       110
       110
       +
         val on_destroy_remove_emails : ('a, 'b) t -> bool option

     

       111
       111
       +
         

     

       112
       112
       +
         val v :

     

       113
       113
       +
           account_id:id ->

     

       114
       114
       +
           ?if_in_state:string ->

     

       115
       115
       +
           ?create:'a id_map ->

     

       116
       116
       +
           ?update:'b id_map ->

     

       117
       117
       +
           ?destroy:id list ->

     

       118
       118
       +
           ?on_success_destroy_original:bool ->

     

       119
       119
       +
           ?destroy_from_if_in_state:string ->

     

       120
       120
       +
           ?on_destroy_remove_emails:bool ->

     

       121
       121
       +
           unit ->

     

       122
       122
       +
           ('a, 'b) t

     

       123
       123
       +
       end

     

       124
       124
       +
       

     

       125
       125
       +
       (** Response for /set methods.

     

       126
       126
       +
           ['created_record_info] is the server-set info for created records.

     

       127
       127
       +
           ['updated_record_info] is the server-set/computed info for updated records.

     

       128
       128
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)

     

       129
       129
       +
       module Set_response : sig

     

       130
       130
       +
         type ('created_record_info, 'updated_record_info) t

     

       131
       131
       +
         

     

       132
       132
       +
         val account_id : ('a, 'b) t -> id

     

       133
       133
       +
         val old_state : ('a, 'b) t -> string option

     

       134
       134
       +
         val new_state : ('a, 'b) t -> string

     

       135
       135
       +
         val created : ('a, 'b) t -> 'a id_map option

     

       136
       136
       +
         val updated : ('a, 'b) t -> 'b option id_map option

     

       137
       137
       +
         val destroyed : ('a, 'b) t -> id list option

     

       138
       138
       +
         val not_created : ('a, 'b) t -> Set_error.t id_map option

     

       139
       139
       +
         val not_updated : ('a, 'b) t -> Set_error.t id_map option

     

       140
       140
       +
         val not_destroyed : ('a, 'b) t -> Set_error.t id_map option

     

       141
       141
       +
         

     

       142
       142
       +
         val v :

     

       143
       143
       +
           account_id:id ->

     

       144
       144
       +
           ?old_state:string ->

     

       145
       145
       +
           new_state:string ->

     

       146
       146
       +
           ?created:'a id_map ->

     

       147
       147
       +
           ?updated:'b option id_map ->

     

       148
       148
       +
           ?destroyed:id list ->

     

       149
       149
       +
           ?not_created:Set_error.t id_map ->

     

       150
       150
       +
           ?not_updated:Set_error.t id_map ->

     

       151
       151
       +
           ?not_destroyed:Set_error.t id_map ->

     

       152
       152
       +
           unit ->

     

       153
       153
       +
           ('a, 'b) t

     

       154
       154
       +
       end

     

       155
       155
       +
       

     

       156
       156
       +
       (** Arguments for /copy methods.

     

       157
       157
       +
           ['copy_record_override] contains the record id and override properties.

     

       158
       158
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)

     

       159
       159
       +
       module Copy_args : sig

     

       160
       160
       +
         type 'copy_record_override t

     

       161
       161
       +
         

     

       162
       162
       +
         val from_account_id : 'a t -> id

     

       163
       163
       +
         val if_from_in_state : 'a t -> string option

     

       164
       164
       +
         val account_id : 'a t -> id

     

       165
       165
       +
         val if_in_state : 'a t -> string option

     

       166
       166
       +
         val create : 'a t -> 'a id_map

     

       167
       167
       +
         val on_success_destroy_original : 'a t -> bool

     

       168
       168
       +
         val destroy_from_if_in_state : 'a t -> string option

     

       169
       169
       +
         

     

       170
       170
       +
         val v :

     

       171
       171
       +
           from_account_id:id ->

     

       172
       172
       +
           ?if_from_in_state:string ->

     

       173
       173
       +
           account_id:id ->

     

       174
       174
       +
           ?if_in_state:string ->

     

       175
       175
       +
           create:'a id_map ->

     

       176
       176
       +
           ?on_success_destroy_original:bool ->

     

       177
       177
       +
           ?destroy_from_if_in_state:string ->

     

       178
       178
       +
           unit ->

     

       179
       179
       +
           'a t

     

       180
       180
       +
       end

     

       181
       181
       +
       

     

       182
       182
       +
       (** Response for /copy methods.

     

       183
       183
       +
           ['created_record_info] is the server-set info for the created copy.

     

       184
       184
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)

     

       185
       185
       +
       module Copy_response : sig

     

       186
       186
       +
         type 'created_record_info t

     

       187
       187
       +
         

     

       188
       188
       +
         val from_account_id : 'a t -> id

     

       189
       189
       +
         val account_id : 'a t -> id

     

       190
       190
       +
         val old_state : 'a t -> string option

     

       191
       191
       +
         val new_state : 'a t -> string

     

       192
       192
       +
         val created : 'a t -> 'a id_map option

     

       193
       193
       +
         val not_created : 'a t -> Set_error.t id_map option

     

       194
       194
       +
         

     

       195
       195
       +
         val v :

     

       196
       196
       +
           from_account_id:id ->

     

       197
       197
       +
           account_id:id ->

     

       198
       198
       +
           ?old_state:string ->

     

       199
       199
       +
           new_state:string ->

     

       200
       200
       +
           ?created:'a id_map ->

     

       201
       201
       +
           ?not_created:Set_error.t id_map ->

     

       202
       202
       +
           unit ->

     

       203
       203
       +
           'a t

     

       204
       204
       +
       end

     

       205
       205
       +
       

     

       206
       206
       +
       (** Module for generic filter representation.

     

       207
       207
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       208
       208
       +
       module Filter : sig

     

       209
       209
       +
         type t

     

       210
       210
       +
         

     

       211
       211
       +
         (** Create a filter from a raw JSON condition *)

     

       212
       212
       +
         val condition : Yojson.Safe.t -> t

     

       213
       213
       +
         

     

       214
       214
       +
         (** Create a filter with a logical operator (AND, OR, NOT) *)

     

       215
       215
       +
         val operator : [ `AND | `OR | `NOT ] -> t list -> t

     

       216
       216
       +
         

     

       217
       217
       +
         (** Combine filters with AND *)

     

       218
       218
       +
         val and_ : t list -> t

     

       219
       219
       +
         

     

       220
       220
       +
         (** Combine filters with OR *)

     

       221
       221
       +
         val or_ : t list -> t

     

       222
       222
       +
         

     

       223
       223
       +
         (** Negate a filter with NOT *)

     

       224
       224
       +
         val not_ : t -> t

     

       225
       225
       +
         

     

       226
       226
       +
         (** Convert a filter to JSON *)

     

       227
       227
       +
         val to_json : t -> Yojson.Safe.t

     

       228
       228
       +
         

     

       229
       229
       +
         (** Predefined filter helpers *)

     

       230
       230
       +
         

     

       231
       231
       +
         (** Create a filter for a text property containing a string *)

     

       232
       232
       +
         val text_contains : string -> string -> t

     

       233
       233
       +
         

     

       234
       234
       +
         (** Create a filter for a property being equal to a value *)

     

       235
       235
       +
         val property_equals : string -> Yojson.Safe.t -> t

     

       236
       236
       +
         

     

       237
       237
       +
         (** Create a filter for a property being not equal to a value *)

     

       238
       238
       +
         val property_not_equals : string -> Yojson.Safe.t -> t

     

       239
       239
       +
         

     

       240
       240
       +
         (** Create a filter for a property being greater than a value *)

     

       241
       241
       +
         val property_gt : string -> Yojson.Safe.t -> t

     

       242
       242
       +
         

     

       243
       243
       +
         (** Create a filter for a property being greater than or equal to a value *)

     

       244
       244
       +
         val property_ge : string -> Yojson.Safe.t -> t

     

       245
       245
       +
         

     

       246
       246
       +
         (** Create a filter for a property being less than a value *)

     

       247
       247
       +
         val property_lt : string -> Yojson.Safe.t -> t

     

       248
       248
       +
         

     

       249
       249
       +
         (** Create a filter for a property being less than or equal to a value *)

     

       250
       250
       +
         val property_le : string -> Yojson.Safe.t -> t

     

       251
       251
       +
         

     

       252
       252
       +
         (** Create a filter for a property value being in a list *)

     

       253
       253
       +
         val property_in : string -> Yojson.Safe.t list -> t

     

       254
       254
       +
         

     

       255
       255
       +
         (** Create a filter for a property value not being in a list *)

     

       256
       256
       +
         val property_not_in : string -> Yojson.Safe.t list -> t

     

       257
       257
       +
         

     

       258
       258
       +
         (** Create a filter for a property being present (not null) *)

     

       259
       259
       +
         val property_exists : string -> t

     

       260
       260
       +
         

     

       261
       261
       +
         (** Create a filter for a string property starting with a prefix *)

     

       262
       262
       +
         val string_starts_with : string -> string -> t

     

       263
       263
       +
         

     

       264
       264
       +
         (** Create a filter for a string property ending with a suffix *)

     

       265
       265
       +
         val string_ends_with : string -> string -> t

     

       266
       266
       +
       end

     

       267
       267
       +
       

     

       268
       268
       +
       

     

       269
       269
       +
       

     

       270
       270
       +
       (** Comparator for sorting.

     

       271
       271
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       272
       272
       +
       module Comparator : sig

     

       273
       273
       +
         type t

     

       274
       274
       +
         

     

       275
       275
       +
         val property : t -> string

     

       276
       276
       +
         val is_ascending : t -> bool option

     

       277
       277
       +
         val collation : t -> string option

     

       278
       278
       +
         val keyword : t -> string option

     

       279
       279
       +
         val other_fields : t -> Yojson.Safe.t string_map

     

       280
       280
       +
         

     

       281
       281
       +
         val v :

     

       282
       282
       +
           property:string ->

     

       283
       283
       +
           ?is_ascending:bool ->

     

       284
       284
       +
           ?collation:string ->

     

       285
       285
       +
           ?keyword:string ->

     

       286
       286
       +
           ?other_fields:Yojson.Safe.t string_map ->

     

       287
       287
       +
           unit ->

     

       288
       288
       +
           t

     

       289
       289
       +
       end

     

       290
       290
       +
       

     

       291
       291
       +
       (** Arguments for /query methods.

     

       292
       292
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       293
       293
       +
       module Query_args : sig

     

       294
       294
       +
         type t

     

       295
       295
       +
         

     

       296
       296
       +
         val account_id : t -> id

     

       297
       297
       +
         val filter : t -> Filter.t option

     

       298
       298
       +
         val sort : t -> Comparator.t list option

     

       299
       299
       +
         val position : t -> jint option

     

       300
       300
       +
         val anchor : t -> id option

     

       301
       301
       +
         val anchor_offset : t -> jint option

     

       302
       302
       +
         val limit : t -> uint option

     

       303
       303
       +
         val calculate_total : t -> bool option

     

       304
       304
       +
         val collapse_threads : t -> bool option

     

       305
       305
       +
         val sort_as_tree : t -> bool option

     

       306
       306
       +
         val filter_as_tree : t -> bool option

     

       307
       307
       +
         

     

       308
       308
       +
         val v :

     

       309
       309
       +
           account_id:id ->

     

       310
       310
       +
           ?filter:Filter.t ->

     

       311
       311
       +
           ?sort:Comparator.t list ->

     

       312
       312
       +
           ?position:jint ->

     

       313
       313
       +
           ?anchor:id ->

     

       314
       314
       +
           ?anchor_offset:jint ->

     

       315
       315
       +
           ?limit:uint ->

     

       316
       316
       +
           ?calculate_total:bool ->

     

       317
       317
       +
           ?collapse_threads:bool ->

     

       318
       318
       +
           ?sort_as_tree:bool ->

     

       319
       319
       +
           ?filter_as_tree:bool ->

     

       320
       320
       +
           unit ->

     

       321
       321
       +
           t

     

       322
       322
       +
       end

     

       323
       323
       +
       

     

       324
       324
       +
       (** Response for /query methods.

     

       325
       325
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)

     

       326
       326
       +
       module Query_response : sig

     

       327
       327
       +
         type t

     

       328
       328
       +
         

     

       329
       329
       +
         val account_id : t -> id

     

       330
       330
       +
         val query_state : t -> string

     

       331
       331
       +
         val can_calculate_changes : t -> bool

     

       332
       332
       +
         val position : t -> uint

     

       333
       333
       +
         val ids : t -> id list

     

       334
       334
       +
         val total : t -> uint option

     

       335
       335
       +
         val limit : t -> uint option

     

       336
       336
       +
         

     

       337
       337
       +
         val v :

     

       338
       338
       +
           account_id:id ->

     

       339
       339
       +
           query_state:string ->

     

       340
       340
       +
           can_calculate_changes:bool ->

     

       341
       341
       +
           position:uint ->

     

       342
       342
       +
           ids:id list ->

     

       343
       343
       +
           ?total:uint ->

     

       344
       344
       +
           ?limit:uint ->

     

       345
       345
       +
           unit ->

     

       346
       346
       +
           t

     

       347
       347
       +
       end

     

       348
       348
       +
       

     

       349
       349
       +
       (** Item indicating an added record in /queryChanges.

     

       350
       350
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       351
       351
       +
       module Added_item : sig

     

       352
       352
       +
         type t

     

       353
       353
       +
         

     

       354
       354
       +
         val id : t -> id

     

       355
       355
       +
         val index : t -> uint

     

       356
       356
       +
         

     

       357
       357
       +
         val v :

     

       358
       358
       +
           id:id ->

     

       359
       359
       +
           index:uint ->

     

       360
       360
       +
           unit ->

     

       361
       361
       +
           t

     

       362
       362
       +
       end

     

       363
       363
       +
       

     

       364
       364
       +
       (** Arguments for /queryChanges methods.

     

       365
       365
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       366
       366
       +
       module Query_changes_args : sig

     

       367
       367
       +
         type t

     

       368
       368
       +
         

     

       369
       369
       +
         val account_id : t -> id

     

       370
       370
       +
         val filter : t -> Filter.t option

     

       371
       371
       +
         val sort : t -> Comparator.t list option

     

       372
       372
       +
         val since_query_state : t -> string

     

       373
       373
       +
         val max_changes : t -> uint option

     

       374
       374
       +
         val up_to_id : t -> id option

     

       375
       375
       +
         val calculate_total : t -> bool option

     

       376
       376
       +
         val collapse_threads : t -> bool option

     

       377
       377
       +
         

     

       378
       378
       +
         val v :

     

       379
       379
       +
           account_id:id ->

     

       380
       380
       +
           ?filter:Filter.t ->

     

       381
       381
       +
           ?sort:Comparator.t list ->

     

       382
       382
       +
           since_query_state:string ->

     

       383
       383
       +
           ?max_changes:uint ->

     

       384
       384
       +
           ?up_to_id:id ->

     

       385
       385
       +
           ?calculate_total:bool ->

     

       386
       386
       +
           ?collapse_threads:bool ->

     

       387
       387
       +
           unit ->

     

       388
       388
       +
           t

     

       389
       389
       +
       end

     

       390
       390
       +
       

     

       391
       391
       +
       (** Response for /queryChanges methods.

     

       392
       392
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)

     

       393
       393
       +
       module Query_changes_response : sig

     

       394
       394
       +
         type t

     

       395
       395
       +
         

     

       396
       396
       +
         val account_id : t -> id

     

       397
       397
       +
         val old_query_state : t -> string

     

       398
       398
       +
         val new_query_state : t -> string

     

       399
       399
       +
         val total : t -> uint option

     

       400
       400
       +
         val removed : t -> id list

     

       401
       401
       +
         val added : t -> Added_item.t list

     

       402
       402
       +
         

     

       403
       403
       +
         val v :

     

       404
       404
       +
           account_id:id ->

     

       405
       405
       +
           old_query_state:string ->

     

       406
       406
       +
           new_query_state:string ->

     

       407
       407
       +
           ?total:uint ->

     

       408
       408
       +
           removed:id list ->

     

       409
       409
       +
           added:Added_item.t list ->

     

       410
       410
       +
           unit ->

     

       411
       411
       +
           t

     

       412
       412
       +
       end

     

       413
       413
       +
       

     

       414
       414
       +
       (** Core/echo method: Arguments are mirrored in the response.

     

       415
       415
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 *)

     

       416
       416
       +
       type core_echo_args = Yojson.Safe.t

     

       417
       417
       +
       type core_echo_response = Yojson.Safe.t

+192

jmap/jmap_push.ml

···

       1
       1
       +
       (* JMAP Push Notifications. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       open Jmap_methods

     

       5
       5
       +
       open Jmap_error

     

       6
       6
       +
       

     

       7
       7
       +
       (* TypeState object map (TypeName -> StateString). *)

     

       8
       8
       +
       type type_state = string string_map

     

       9
       9
       +
       

     

       10
       10
       +
       (* StateChange object. *)

     

       11
       11
       +
       module State_change = struct

     

       12
       12
       +
         type t = {

     

       13
       13
       +
           changed: type_state id_map;

     

       14
       14
       +
         }

     

       15
       15
       +
         

     

       16
       16
       +
         let changed t = t.changed

     

       17
       17
       +
         

     

       18
       18
       +
         let v ~changed () = { changed }

     

       19
       19
       +
       end

     

       20
       20
       +
       

     

       21
       21
       +
       (* PushSubscription encryption keys. *)

     

       22
       22
       +
       module Push_encryption_keys = struct

     

       23
       23
       +
         type t = {

     

       24
       24
       +
           p256dh: string;

     

       25
       25
       +
           auth: string;

     

       26
       26
       +
         }

     

       27
       27
       +
         

     

       28
       28
       +
         let p256dh t = t.p256dh

     

       29
       29
       +
         let auth t = t.auth

     

       30
       30
       +
         

     

       31
       31
       +
         let v ~p256dh ~auth () = { p256dh; auth }

     

       32
       32
       +
       end

     

       33
       33
       +
       

     

       34
       34
       +
       (* PushSubscription object. *)

     

       35
       35
       +
       module Push_subscription = struct

     

       36
       36
       +
         type t = {

     

       37
       37
       +
           id: id;

     

       38
       38
       +
           device_client_id: string;

     

       39
       39
       +
           url: Uri.t;

     

       40
       40
       +
           keys: Push_encryption_keys.t option;

     

       41
       41
       +
           verification_code: string option;

     

       42
       42
       +
           expires: utc_date option;

     

       43
       43
       +
           types: string list option;

     

       44
       44
       +
         }

     

       45
       45
       +
         

     

       46
       46
       +
         let id t = t.id

     

       47
       47
       +
         let device_client_id t = t.device_client_id

     

       48
       48
       +
         let url t = t.url

     

       49
       49
       +
         let keys t = t.keys

     

       50
       50
       +
         let verification_code t = t.verification_code

     

       51
       51
       +
         let expires t = t.expires

     

       52
       52
       +
         let types t = t.types

     

       53
       53
       +
         

     

       54
       54
       +
         let v ~id ~device_client_id ~url ?keys ?verification_code ?expires ?types () =

     

       55
       55
       +
           { id; device_client_id; url; keys; verification_code; expires; types }

     

       56
       56
       +
       end

     

       57
       57
       +
       

     

       58
       58
       +
       (* PushSubscription object for creation (omits server-set fields). *)

     

       59
       59
       +
       module Push_subscription_create = struct

     

       60
       60
       +
         type t = {

     

       61
       61
       +
           device_client_id: string;

     

       62
       62
       +
           url: Uri.t;

     

       63
       63
       +
           keys: Push_encryption_keys.t option;

     

       64
       64
       +
           expires: utc_date option;

     

       65
       65
       +
           types: string list option;

     

       66
       66
       +
         }

     

       67
       67
       +
         

     

       68
       68
       +
         let device_client_id t = t.device_client_id

     

       69
       69
       +
         let url t = t.url

     

       70
       70
       +
         let keys t = t.keys

     

       71
       71
       +
         let expires t = t.expires

     

       72
       72
       +
         let types t = t.types

     

       73
       73
       +
         

     

       74
       74
       +
         let v ~device_client_id ~url ?keys ?expires ?types () =

     

       75
       75
       +
           { device_client_id; url; keys; expires; types }

     

       76
       76
       +
       end

     

       77
       77
       +
       

     

       78
       78
       +
       (* PushSubscription object for update patch.

     

       79
       79
       +
          Only verification_code and expires can be updated. *)

     

       80
       80
       +
       type push_subscription_update = patch_object

     

       81
       81
       +
       

     

       82
       82
       +
       (* Arguments for PushSubscription/get. *)

     

       83
       83
       +
       module Push_subscription_get_args = struct

     

       84
       84
       +
         type t = {

     

       85
       85
       +
           ids: id list option;

     

       86
       86
       +
           properties: string list option;

     

       87
       87
       +
         }

     

       88
       88
       +
         

     

       89
       89
       +
         let ids t = t.ids

     

       90
       90
       +
         let properties t = t.properties

     

       91
       91
       +
         

     

       92
       92
       +
         let v ?ids ?properties () = { ids; properties }

     

       93
       93
       +
       end

     

       94
       94
       +
       

     

       95
       95
       +
       (* Response for PushSubscription/get. *)

     

       96
       96
       +
       module Push_subscription_get_response = struct

     

       97
       97
       +
         type t = {

     

       98
       98
       +
           list: Push_subscription.t list;

     

       99
       99
       +
           not_found: id list;

     

       100
       100
       +
         }

     

       101
       101
       +
         

     

       102
       102
       +
         let list t = t.list

     

       103
       103
       +
         let not_found t = t.not_found

     

       104
       104
       +
         

     

       105
       105
       +
         let v ~list ~not_found () = { list; not_found }

     

       106
       106
       +
       end

     

       107
       107
       +
       

     

       108
       108
       +
       (* Arguments for PushSubscription/set. *)

     

       109
       109
       +
       module Push_subscription_set_args = struct

     

       110
       110
       +
         type t = {

     

       111
       111
       +
           create: Push_subscription_create.t id_map option;

     

       112
       112
       +
           update: push_subscription_update id_map option;

     

       113
       113
       +
           destroy: id list option;

     

       114
       114
       +
         }

     

       115
       115
       +
         

     

       116
       116
       +
         let create t = t.create

     

       117
       117
       +
         let update t = t.update

     

       118
       118
       +
         let destroy t = t.destroy

     

       119
       119
       +
         

     

       120
       120
       +
         let v ?create ?update ?destroy () = { create; update; destroy }

     

       121
       121
       +
       end

     

       122
       122
       +
       

     

       123
       123
       +
       (* Server-set information for created PushSubscription. *)

     

       124
       124
       +
       module Push_subscription_created_info = struct

     

       125
       125
       +
         type t = {

     

       126
       126
       +
           id: id;

     

       127
       127
       +
           expires: utc_date option;

     

       128
       128
       +
         }

     

       129
       129
       +
         

     

       130
       130
       +
         let id t = t.id

     

       131
       131
       +
         let expires t = t.expires

     

       132
       132
       +
         

     

       133
       133
       +
         let v ~id ?expires () = { id; expires }

     

       134
       134
       +
       end

     

       135
       135
       +
       

     

       136
       136
       +
       (* Server-set information for updated PushSubscription. *)

     

       137
       137
       +
       module Push_subscription_updated_info = struct

     

       138
       138
       +
         type t = {

     

       139
       139
       +
           expires: utc_date option;

     

       140
       140
       +
         }

     

       141
       141
       +
         

     

       142
       142
       +
         let expires t = t.expires

     

       143
       143
       +
         

     

       144
       144
       +
         let v ?expires () = { expires }

     

       145
       145
       +
       end

     

       146
       146
       +
       

     

       147
       147
       +
       (* Response for PushSubscription/set. *)

     

       148
       148
       +
       module Push_subscription_set_response = struct

     

       149
       149
       +
         type t = {

     

       150
       150
       +
           created: Push_subscription_created_info.t id_map option;

     

       151
       151
       +
           updated: Push_subscription_updated_info.t option id_map option;

     

       152
       152
       +
           destroyed: id list option;

     

       153
       153
       +
           not_created: Set_error.t id_map option;

     

       154
       154
       +
           not_updated: Set_error.t id_map option;

     

       155
       155
       +
           not_destroyed: Set_error.t id_map option;

     

       156
       156
       +
         }

     

       157
       157
       +
         

     

       158
       158
       +
         let created t = t.created

     

       159
       159
       +
         let updated t = t.updated

     

       160
       160
       +
         let destroyed t = t.destroyed

     

       161
       161
       +
         let not_created t = t.not_created

     

       162
       162
       +
         let not_updated t = t.not_updated

     

       163
       163
       +
         let not_destroyed t = t.not_destroyed

     

       164
       164
       +
         

     

       165
       165
       +
         let v ?created ?updated ?destroyed ?not_created ?not_updated ?not_destroyed () =

     

       166
       166
       +
           { created; updated; destroyed; not_created; not_updated; not_destroyed }

     

       167
       167
       +
       end

     

       168
       168
       +
       

     

       169
       169
       +
       (* PushVerification object. *)

     

       170
       170
       +
       module Push_verification = struct

     

       171
       171
       +
         type t = {

     

       172
       172
       +
           push_subscription_id: id;

     

       173
       173
       +
           verification_code: string;

     

       174
       174
       +
         }

     

       175
       175
       +
         

     

       176
       176
       +
         let push_subscription_id t = t.push_subscription_id

     

       177
       177
       +
         let verification_code t = t.verification_code

     

       178
       178
       +
         

     

       179
       179
       +
         let v ~push_subscription_id ~verification_code () =

     

       180
       180
       +
           { push_subscription_id; verification_code }

     

       181
       181
       +
       end

     

       182
       182
       +
       

     

       183
       183
       +
       (* Data for EventSource ping event. *)

     

       184
       184
       +
       module Event_source_ping_data = struct

     

       185
       185
       +
         type t = {

     

       186
       186
       +
           interval: uint;

     

       187
       187
       +
         }

     

       188
       188
       +
         

     

       189
       189
       +
         let interval t = t.interval

     

       190
       190
       +
         

     

       191
       191
       +
         let v ~interval () = { interval }

     

       192
       192
       +
       end

+230

jmap/jmap_push.mli

···

       1
       1
       +
       (** JMAP Push Notifications.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       open Jmap_methods

     

       6
       6
       +
       open Jmap_error

     

       7
       7
       +
       

     

       8
       8
       +
       (** TypeState object map (TypeName -> StateString).

     

       9
       9
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)

     

       10
       10
       +
       type type_state = string string_map

     

       11
       11
       +
       

     

       12
       12
       +
       (** StateChange object.

     

       13
       13
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)

     

       14
       14
       +
       module State_change : sig

     

       15
       15
       +
         type t

     

       16
       16
       +
         

     

       17
       17
       +
         val changed : t -> type_state id_map

     

       18
       18
       +
         

     

       19
       19
       +
         val v :

     

       20
       20
       +
           changed:type_state id_map ->

     

       21
       21
       +
           unit ->

     

       22
       22
       +
           t

     

       23
       23
       +
       end

     

       24
       24
       +
       

     

       25
       25
       +
       (** PushSubscription encryption keys.

     

       26
       26
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       27
       27
       +
       module Push_encryption_keys : sig

     

       28
       28
       +
         type t

     

       29
       29
       +
         

     

       30
       30
       +
         (** P-256 ECDH public key (URL-safe base64) *)

     

       31
       31
       +
         val p256dh : t -> string

     

       32
       32
       +
         

     

       33
       33
       +
         (** Authentication secret (URL-safe base64) *)

     

       34
       34
       +
         val auth : t -> string

     

       35
       35
       +
         

     

       36
       36
       +
         val v :

     

       37
       37
       +
           p256dh:string ->

     

       38
       38
       +
           auth:string ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** PushSubscription object.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       45
       45
       +
       module Push_subscription : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         (** Id of the subscription (server-set, immutable) *)

     

       49
       49
       +
         val id : t -> id

     

       50
       50
       +
         

     

       51
       51
       +
         (** Device client id (immutable) *)

     

       52
       52
       +
         val device_client_id : t -> string

     

       53
       53
       +
         

     

       54
       54
       +
         (** Notification URL (immutable) *)

     

       55
       55
       +
         val url : t -> Uri.t

     

       56
       56
       +
         

     

       57
       57
       +
         (** Encryption keys (immutable) *)

     

       58
       58
       +
         val keys : t -> Push_encryption_keys.t option

     

       59
       59
       +
         val verification_code : t -> string option

     

       60
       60
       +
         val expires : t -> utc_date option

     

       61
       61
       +
         val types : t -> string list option

     

       62
       62
       +
         

     

       63
       63
       +
         val v :

     

       64
       64
       +
           id:id ->

     

       65
       65
       +
           device_client_id:string ->

     

       66
       66
       +
           url:Uri.t ->

     

       67
       67
       +
           ?keys:Push_encryption_keys.t ->

     

       68
       68
       +
           ?verification_code:string ->

     

       69
       69
       +
           ?expires:utc_date ->

     

       70
       70
       +
           ?types:string list ->

     

       71
       71
       +
           unit ->

     

       72
       72
       +
           t

     

       73
       73
       +
       end

     

       74
       74
       +
       

     

       75
       75
       +
       (** PushSubscription object for creation (omits server-set fields).

     

       76
       76
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)

     

       77
       77
       +
       module Push_subscription_create : sig

     

       78
       78
       +
         type t

     

       79
       79
       +
         

     

       80
       80
       +
         val device_client_id : t -> string

     

       81
       81
       +
         val url : t -> Uri.t

     

       82
       82
       +
         val keys : t -> Push_encryption_keys.t option

     

       83
       83
       +
         val expires : t -> utc_date option

     

       84
       84
       +
         val types : t -> string list option

     

       85
       85
       +
         

     

       86
       86
       +
         val v :

     

       87
       87
       +
           device_client_id:string ->

     

       88
       88
       +
           url:Uri.t ->

     

       89
       89
       +
           ?keys:Push_encryption_keys.t ->

     

       90
       90
       +
           ?expires:utc_date ->

     

       91
       91
       +
           ?types:string list ->

     

       92
       92
       +
           unit ->

     

       93
       93
       +
           t

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (** PushSubscription object for update patch.

     

       97
       97
       +
           Only verification_code and expires can be updated.

     

       98
       98
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2

     

       99
       99
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       100
       100
       +
       type push_subscription_update = patch_object

     

       101
       101
       +
       

     

       102
       102
       +
       (** Arguments for PushSubscription/get.

     

       103
       103
       +
           Extends standard /get args.

     

       104
       104
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)

     

       105
       105
       +
       module Push_subscription_get_args : sig

     

       106
       106
       +
         type t

     

       107
       107
       +
         

     

       108
       108
       +
         val ids : t -> id list option

     

       109
       109
       +
         val properties : t -> string list option

     

       110
       110
       +
         

     

       111
       111
       +
         val v :

     

       112
       112
       +
           ?ids:id list ->

     

       113
       113
       +
           ?properties:string list ->

     

       114
       114
       +
           unit ->

     

       115
       115
       +
           t

     

       116
       116
       +
       end

     

       117
       117
       +
       

     

       118
       118
       +
       (** Response for PushSubscription/get.

     

       119
       119
       +
           Extends standard /get response.

     

       120
       120
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)

     

       121
       121
       +
       module Push_subscription_get_response : sig

     

       122
       122
       +
         type t

     

       123
       123
       +
         

     

       124
       124
       +
         val list : t -> Push_subscription.t list

     

       125
       125
       +
         val not_found : t -> id list

     

       126
       126
       +
         

     

       127
       127
       +
         val v :

     

       128
       128
       +
           list:Push_subscription.t list ->

     

       129
       129
       +
           not_found:id list ->

     

       130
       130
       +
           unit ->

     

       131
       131
       +
           t

     

       132
       132
       +
       end

     

       133
       133
       +
       

     

       134
       134
       +
       (** Arguments for PushSubscription/set.

     

       135
       135
       +
           Extends standard /set args.

     

       136
       136
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       137
       137
       +
       module Push_subscription_set_args : sig

     

       138
       138
       +
         type t

     

       139
       139
       +
         

     

       140
       140
       +
         val create : t -> Push_subscription_create.t id_map option

     

       141
       141
       +
         val update : t -> push_subscription_update id_map option

     

       142
       142
       +
         val destroy : t -> id list option

     

       143
       143
       +
         

     

       144
       144
       +
         val v :

     

       145
       145
       +
           ?create:Push_subscription_create.t id_map ->

     

       146
       146
       +
           ?update:push_subscription_update id_map ->

     

       147
       147
       +
           ?destroy:id list ->

     

       148
       148
       +
           unit ->

     

       149
       149
       +
           t

     

       150
       150
       +
       end

     

       151
       151
       +
       

     

       152
       152
       +
       (** Server-set information for created PushSubscription.

     

       153
       153
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       154
       154
       +
       module Push_subscription_created_info : sig

     

       155
       155
       +
         type t

     

       156
       156
       +
         

     

       157
       157
       +
         val id : t -> id

     

       158
       158
       +
         val expires : t -> utc_date option

     

       159
       159
       +
         

     

       160
       160
       +
         val v :

     

       161
       161
       +
           id:id ->

     

       162
       162
       +
           ?expires:utc_date ->

     

       163
       163
       +
           unit ->

     

       164
       164
       +
           t

     

       165
       165
       +
       end

     

       166
       166
       +
       

     

       167
       167
       +
       (** Server-set information for updated PushSubscription.

     

       168
       168
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       169
       169
       +
       module Push_subscription_updated_info : sig

     

       170
       170
       +
         type t

     

       171
       171
       +
         

     

       172
       172
       +
         val expires : t -> utc_date option

     

       173
       173
       +
         

     

       174
       174
       +
         val v :

     

       175
       175
       +
           ?expires:utc_date ->

     

       176
       176
       +
           unit ->

     

       177
       177
       +
           t

     

       178
       178
       +
       end

     

       179
       179
       +
       

     

       180
       180
       +
       (** Response for PushSubscription/set.

     

       181
       181
       +
           Extends standard /set response.

     

       182
       182
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       183
       183
       +
       module Push_subscription_set_response : sig

     

       184
       184
       +
         type t

     

       185
       185
       +
         

     

       186
       186
       +
         val created : t -> Push_subscription_created_info.t id_map option

     

       187
       187
       +
         val updated : t -> Push_subscription_updated_info.t option id_map option

     

       188
       188
       +
         val destroyed : t -> id list option

     

       189
       189
       +
         val not_created : t -> Set_error.t id_map option

     

       190
       190
       +
         val not_updated : t -> Set_error.t id_map option

     

       191
       191
       +
         val not_destroyed : t -> Set_error.t id_map option

     

       192
       192
       +
         

     

       193
       193
       +
         val v :

     

       194
       194
       +
           ?created:Push_subscription_created_info.t id_map ->

     

       195
       195
       +
           ?updated:Push_subscription_updated_info.t option id_map ->

     

       196
       196
       +
           ?destroyed:id list ->

     

       197
       197
       +
           ?not_created:Set_error.t id_map ->

     

       198
       198
       +
           ?not_updated:Set_error.t id_map ->

     

       199
       199
       +
           ?not_destroyed:Set_error.t id_map ->

     

       200
       200
       +
           unit ->

     

       201
       201
       +
           t

     

       202
       202
       +
       end

     

       203
       203
       +
       

     

       204
       204
       +
       (** PushVerification object.

     

       205
       205
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)

     

       206
       206
       +
       module Push_verification : sig

     

       207
       207
       +
         type t

     

       208
       208
       +
         

     

       209
       209
       +
         val push_subscription_id : t -> id

     

       210
       210
       +
         val verification_code : t -> string

     

       211
       211
       +
         

     

       212
       212
       +
         val v :

     

       213
       213
       +
           push_subscription_id:id ->

     

       214
       214
       +
           verification_code:string ->

     

       215
       215
       +
           unit ->

     

       216
       216
       +
           t

     

       217
       217
       +
       end

     

       218
       218
       +
       

     

       219
       219
       +
       (** Data for EventSource ping event.

     

       220
       220
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)

     

       221
       221
       +
       module Event_source_ping_data : sig

     

       222
       222
       +
         type t

     

       223
       223
       +
         

     

       224
       224
       +
         val interval : t -> uint

     

       225
       225
       +
         

     

       226
       226
       +
         val v :

     

       227
       227
       +
           interval:uint ->

     

       228
       228
       +
           unit ->

     

       229
       229
       +
           t

     

       230
       230
       +
       end

+114

jmap/jmap_session.ml

···

       1
       1
       +
       (* JMAP Session Resource. *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       

     

       5
       5
       +
       (* Account capability information.

     

       6
       6
       +
          The value is capability-specific. *)

     

       7
       7
       +
       type account_capability_value = Yojson.Safe.t

     

       8
       8
       +
       

     

       9
       9
       +
       (* Server capability information.

     

       10
       10
       +
          The value is capability-specific. *)

     

       11
       11
       +
       type server_capability_value = Yojson.Safe.t

     

       12
       12
       +
       

     

       13
       13
       +
       (* Core capability information. *)

     

       14
       14
       +
       module Core_capability = struct

     

       15
       15
       +
         type t = {

     

       16
       16
       +
           max_size_upload: uint;

     

       17
       17
       +
           max_concurrent_upload: uint;

     

       18
       18
       +
           max_size_request: uint;

     

       19
       19
       +
           max_concurrent_requests: uint;

     

       20
       20
       +
           max_calls_in_request: uint;

     

       21
       21
       +
           max_objects_in_get: uint;

     

       22
       22
       +
           max_objects_in_set: uint;

     

       23
       23
       +
           collation_algorithms: string list;

     

       24
       24
       +
         }

     

       25
       25
       +
         

     

       26
       26
       +
         let max_size_upload t = t.max_size_upload

     

       27
       27
       +
         let max_concurrent_upload t = t.max_concurrent_upload

     

       28
       28
       +
         let max_size_request t = t.max_size_request

     

       29
       29
       +
         let max_concurrent_requests t = t.max_concurrent_requests

     

       30
       30
       +
         let max_calls_in_request t = t.max_calls_in_request

     

       31
       31
       +
         let max_objects_in_get t = t.max_objects_in_get

     

       32
       32
       +
         let max_objects_in_set t = t.max_objects_in_set

     

       33
       33
       +
         let collation_algorithms t = t.collation_algorithms

     

       34
       34
       +
         

     

       35
       35
       +
         let v ~max_size_upload ~max_concurrent_upload ~max_size_request

     

       36
       36
       +
             ~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get

     

       37
       37
       +
             ~max_objects_in_set ~collation_algorithms () =

     

       38
       38
       +
           { max_size_upload; max_concurrent_upload; max_size_request;

     

       39
       39
       +
             max_concurrent_requests; max_calls_in_request; max_objects_in_get;

     

       40
       40
       +
             max_objects_in_set; collation_algorithms }

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (* An Account object. *)

     

       44
       44
       +
       module Account = struct

     

       45
       45
       +
         type t = {

     

       46
       46
       +
           name: string;

     

       47
       47
       +
           is_personal: bool;

     

       48
       48
       +
           is_read_only: bool;

     

       49
       49
       +
           account_capabilities: account_capability_value string_map;

     

       50
       50
       +
         }

     

       51
       51
       +
         

     

       52
       52
       +
         let name t = t.name

     

       53
       53
       +
         let is_personal t = t.is_personal

     

       54
       54
       +
         let is_read_only t = t.is_read_only

     

       55
       55
       +
         let account_capabilities t = t.account_capabilities

     

       56
       56
       +
         

     

       57
       57
       +
         let v ~name ?(is_personal=true) ?(is_read_only=false)

     

       58
       58
       +
             ?(account_capabilities=Hashtbl.create 0) () =

     

       59
       59
       +
           { name; is_personal; is_read_only; account_capabilities }

     

       60
       60
       +
       end

     

       61
       61
       +
       

     

       62
       62
       +
       (* The Session object. *)

     

       63
       63
       +
       module Session = struct

     

       64
       64
       +
         type t = {

     

       65
       65
       +
           capabilities: server_capability_value string_map;

     

       66
       66
       +
           accounts: Account.t id_map;

     

       67
       67
       +
           primary_accounts: id string_map;

     

       68
       68
       +
           username: string;

     

       69
       69
       +
           api_url: Uri.t;

     

       70
       70
       +
           download_url: Uri.t;

     

       71
       71
       +
           upload_url: Uri.t;

     

       72
       72
       +
           event_source_url: Uri.t;

     

       73
       73
       +
           state: string;

     

       74
       74
       +
         }

     

       75
       75
       +
         

     

       76
       76
       +
         let capabilities t = t.capabilities

     

       77
       77
       +
         let accounts t = t.accounts

     

       78
       78
       +
         let primary_accounts t = t.primary_accounts

     

       79
       79
       +
         let username t = t.username

     

       80
       80
       +
         let api_url t = t.api_url

     

       81
       81
       +
         let download_url t = t.download_url

     

       82
       82
       +
         let upload_url t = t.upload_url

     

       83
       83
       +
         let event_source_url t = t.event_source_url

     

       84
       84
       +
         let state t = t.state

     

       85
       85
       +
         

     

       86
       86
       +
         let v ~capabilities ~accounts ~primary_accounts ~username

     

       87
       87
       +
             ~api_url ~download_url ~upload_url ~event_source_url ~state () =

     

       88
       88
       +
           { capabilities; accounts; primary_accounts; username;

     

       89
       89
       +
             api_url; download_url; upload_url; event_source_url; state }

     

       90
       90
       +
       end

     

       91
       91
       +
       

     

       92
       92
       +
       (* Function to perform service autodiscovery.

     

       93
       93
       +
          Returns the session URL if found. *)

     

       94
       94
       +
       let discover ~domain =

     

       95
       95
       +
         (* This is a placeholder implementation - would need to be completed in Unix implementation *)

     

       96
       96
       +
         let well_known_url = Uri.of_string ("https://" ^ domain ^ "/.well-known/jmap") in

     

       97
       97
       +
         Some well_known_url

     

       98
       98
       +
       

     

       99
       99
       +
       (* Function to fetch the session object from a given URL.

     

       100
       100
       +
          Requires authentication handling (details TBD/outside this signature). *)

     

       101
       101
       +
       let get_session ~url =

     

       102
       102
       +
         (* This is a placeholder implementation - would need to be completed in Unix implementation *)

     

       103
       103
       +
         let empty_map () = Hashtbl.create 0 in

     

       104
       104
       +
         Session.v

     

       105
       105
       +
           ~capabilities:(empty_map ())

     

       106
       106
       +
           ~accounts:(empty_map ())

     

       107
       107
       +
           ~primary_accounts:(empty_map ())

     

       108
       108
       +
           ~username:"placeholder"

     

       109
       109
       +
           ~api_url:url

     

       110
       110
       +
           ~download_url:url

     

       111
       111
       +
           ~upload_url:url

     

       112
       112
       +
           ~event_source_url:url

     

       113
       113
       +
           ~state:"placeholder"

     

       114
       114
       +
           ()

+98

jmap/jmap_session.mli

···

       1
       1
       +
       (** JMAP Session Resource.

     

       2
       2
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       3
       3
       +
       

     

       4
       4
       +
       open Jmap_types

     

       5
       5
       +
       

     

       6
       6
       +
       (** Account capability information.

     

       7
       7
       +
           The value is capability-specific.

     

       8
       8
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       9
       9
       +
       type account_capability_value = Yojson.Safe.t

     

       10
       10
       +
       

     

       11
       11
       +
       (** Server capability information.

     

       12
       12
       +
           The value is capability-specific.

     

       13
       13
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       14
       14
       +
       type server_capability_value = Yojson.Safe.t

     

       15
       15
       +
       

     

       16
       16
       +
       (** Core capability information.

     

       17
       17
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       18
       18
       +
       module Core_capability : sig

     

       19
       19
       +
         type t

     

       20
       20
       +
         

     

       21
       21
       +
         val max_size_upload : t -> uint

     

       22
       22
       +
         val max_concurrent_upload : t -> uint

     

       23
       23
       +
         val max_size_request : t -> uint

     

       24
       24
       +
         val max_concurrent_requests : t -> uint

     

       25
       25
       +
         val max_calls_in_request : t -> uint

     

       26
       26
       +
         val max_objects_in_get : t -> uint

     

       27
       27
       +
         val max_objects_in_set : t -> uint

     

       28
       28
       +
         val collation_algorithms : t -> string list

     

       29
       29
       +
         

     

       30
       30
       +
         val v :

     

       31
       31
       +
           max_size_upload:uint ->

     

       32
       32
       +
           max_concurrent_upload:uint ->

     

       33
       33
       +
           max_size_request:uint ->

     

       34
       34
       +
           max_concurrent_requests:uint ->

     

       35
       35
       +
           max_calls_in_request:uint ->

     

       36
       36
       +
           max_objects_in_get:uint ->

     

       37
       37
       +
           max_objects_in_set:uint ->

     

       38
       38
       +
           collation_algorithms:string list ->

     

       39
       39
       +
           unit ->

     

       40
       40
       +
           t

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (** An Account object.

     

       44
       44
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       45
       45
       +
       module Account : sig

     

       46
       46
       +
         type t

     

       47
       47
       +
         

     

       48
       48
       +
         val name : t -> string

     

       49
       49
       +
         val is_personal : t -> bool

     

       50
       50
       +
         val is_read_only : t -> bool

     

       51
       51
       +
         val account_capabilities : t -> account_capability_value string_map

     

       52
       52
       +
         

     

       53
       53
       +
         val v :

     

       54
       54
       +
           name:string ->

     

       55
       55
       +
           ?is_personal:bool ->

     

       56
       56
       +
           ?is_read_only:bool ->

     

       57
       57
       +
           ?account_capabilities:account_capability_value string_map ->

     

       58
       58
       +
           unit ->

     

       59
       59
       +
           t

     

       60
       60
       +
       end

     

       61
       61
       +
       

     

       62
       62
       +
       (** The Session object.

     

       63
       63
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)

     

       64
       64
       +
       module Session : sig

     

       65
       65
       +
         type t

     

       66
       66
       +
         

     

       67
       67
       +
         val capabilities : t -> server_capability_value string_map

     

       68
       68
       +
         val accounts : t -> Account.t id_map

     

       69
       69
       +
         val primary_accounts : t -> id string_map

     

       70
       70
       +
         val username : t -> string

     

       71
       71
       +
         val api_url : t -> Uri.t

     

       72
       72
       +
         val download_url : t -> Uri.t

     

       73
       73
       +
         val upload_url : t -> Uri.t

     

       74
       74
       +
         val event_source_url : t -> Uri.t

     

       75
       75
       +
         val state : t -> string

     

       76
       76
       +
         

     

       77
       77
       +
         val v :

     

       78
       78
       +
           capabilities:server_capability_value string_map ->

     

       79
       79
       +
           accounts:Account.t id_map ->

     

       80
       80
       +
           primary_accounts:id string_map ->

     

       81
       81
       +
           username:string ->

     

       82
       82
       +
           api_url:Uri.t ->

     

       83
       83
       +
           download_url:Uri.t ->

     

       84
       84
       +
           upload_url:Uri.t ->

     

       85
       85
       +
           event_source_url:Uri.t ->

     

       86
       86
       +
           state:string ->

     

       87
       87
       +
           unit ->

     

       88
       88
       +
           t

     

       89
       89
       +
       end

     

       90
       90
       +
       

     

       91
       91
       +
       (** Function to perform service autodiscovery.

     

       92
       92
       +
           Returns the session URL if found.

     

       93
       93
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)

     

       94
       94
       +
       val discover : domain:string -> Uri.t option

     

       95
       95
       +
       

     

       96
       96
       +
       (** Function to fetch the session object from a given URL.

     

       97
       97
       +
           Requires authentication handling (details TBD/outside this signature). *)

     

       98
       98
       +
       val get_session : url:Uri.t -> Session.t

+32

jmap/jmap_types.ml

···

       1
       1
       +
       (* Basic JMAP types as defined in RFC 8620. *)

     

       2
       2
       +
       

     

       3
       3
       +
       (* The Id data type.

     

       4
       4
       +
          A string of 1 to 255 octets, using URL-safe base64 characters. *)

     

       5
       5
       +
       type id = string

     

       6
       6
       +
       

     

       7
       7
       +
       (* The Int data type.

     

       8
       8
       +
          An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int]. *)

     

       9
       9
       +
       type jint = int

     

       10
       10
       +
       

     

       11
       11
       +
       (* The UnsignedInt data type.

     

       12
       12
       +
          An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int]. *)

     

       13
       13
       +
       type uint = int

     

       14
       14
       +
       

     

       15
       15
       +
       (* The Date data type.

     

       16
       16
       +
          A string in RFC 3339 "date-time" format.

     

       17
       17
       +
          Represented as a float using Unix time. *)

     

       18
       18
       +
       type date = float

     

       19
       19
       +
       

     

       20
       20
       +
       (* The UTCDate data type.

     

       21
       21
       +
          A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).

     

       22
       22
       +
          Represented as a float using Unix time. *)

     

       23
       23
       +
       type utc_date = float

     

       24
       24
       +
       

     

       25
       25
       +
       (* Represents a JSON object used as a map String -> V. *)

     

       26
       26
       +
       type 'v string_map = (string, 'v) Hashtbl.t

     

       27
       27
       +
       

     

       28
       28
       +
       (* Represents a JSON object used as a map Id -> V. *)

     

       29
       29
       +
       type 'v id_map = (id, 'v) Hashtbl.t

     

       30
       30
       +
       

     

       31
       31
       +
       (* Represents a JSON Pointer path with JMAP extensions. *)

     

       32
       32
       +
       type json_pointer = string

+38

jmap/jmap_types.mli

···

       1
       1
       +
       (** Basic JMAP types as defined in RFC 8620. *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** The Id data type.

     

       4
       4
       +
           A string of 1 to 255 octets, using URL-safe base64 characters.

     

       5
       5
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)

     

       6
       6
       +
       type id = string

     

       7
       7
       +
       

     

       8
       8
       +
       (** The Int data type.

     

       9
       9
       +
           An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int].

     

       10
       10
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)

     

       11
       11
       +
       type jint = int

     

       12
       12
       +
       

     

       13
       13
       +
       (** The UnsignedInt data type.

     

       14
       14
       +
           An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int].

     

       15
       15
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)

     

       16
       16
       +
       type uint = int

     

       17
       17
       +
       

     

       18
       18
       +
       (** The Date data type.

     

       19
       19
       +
           A string in RFC 3339 "date-time" format.

     

       20
       20
       +
           Represented as a float using Unix time.

     

       21
       21
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)

     

       22
       22
       +
       type date = float

     

       23
       23
       +
       

     

       24
       24
       +
       (** The UTCDate data type.

     

       25
       25
       +
           A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).

     

       26
       26
       +
           Represented as a float using Unix time.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)

     

       28
       28
       +
       type utc_date = float

     

       29
       29
       +
       

     

       30
       30
       +
       (** Represents a JSON object used as a map String -> V. *)

     

       31
       31
       +
       type 'v string_map = (string, 'v) Hashtbl.t

     

       32
       32
       +
       

     

       33
       33
       +
       (** Represents a JSON object used as a map Id -> V. *)

     

       34
       34
       +
       type 'v id_map = (id, 'v) Hashtbl.t

     

       35
       35
       +
       

     

       36
       36
       +
       (** Represents a JSON Pointer path with JMAP extensions.

     

       37
       37
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)

     

       38
       38
       +
       type json_pointer = string

+73

jmap/jmap_wire.ml

···

       1
       1
       +
       (* JMAP Wire Protocol Structures (Request/Response). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       

     

       5
       5
       +
       (* An invocation tuple within a request or response. *)

     

       6
       6
       +
       module Invocation = struct

     

       7
       7
       +
         type t = {

     

       8
       8
       +
           method_name: string;

     

       9
       9
       +
           arguments: Yojson.Safe.t;

     

       10
       10
       +
           method_call_id: string;

     

       11
       11
       +
         }

     

       12
       12
       +
         

     

       13
       13
       +
         let method_name t = t.method_name

     

       14
       14
       +
         let arguments t = t.arguments

     

       15
       15
       +
         let method_call_id t = t.method_call_id

     

       16
       16
       +
         

     

       17
       17
       +
         let v ?(arguments=`Assoc []) ~method_name ~method_call_id () =

     

       18
       18
       +
           { method_name; arguments; method_call_id }

     

       19
       19
       +
       end

     

       20
       20
       +
       

     

       21
       21
       +
       (* Method error type with context. *)

     

       22
       22
       +
       type method_error = Jmap_error.Method_error.t * string

     

       23
       23
       +
       

     

       24
       24
       +
       (* A response invocation part, which can be a standard response or an error. *)

     

       25
       25
       +
       type response_invocation = (Invocation.t, method_error) result

     

       26
       26
       +
       

     

       27
       27
       +
       (* A reference to a previous method call's result. *)

     

       28
       28
       +
       module Result_reference = struct

     

       29
       29
       +
         type t = {

     

       30
       30
       +
           result_of: string;

     

       31
       31
       +
           name: string;

     

       32
       32
       +
           path: json_pointer;

     

       33
       33
       +
         }

     

       34
       34
       +
         

     

       35
       35
       +
         let result_of t = t.result_of

     

       36
       36
       +
         let name t = t.name

     

       37
       37
       +
         let path t = t.path

     

       38
       38
       +
         

     

       39
       39
       +
         let v ~result_of ~name ~path () =

     

       40
       40
       +
           { result_of; name; path }

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       (* The Request object. *)

     

       44
       44
       +
       module Request = struct

     

       45
       45
       +
         type t = {

     

       46
       46
       +
           using: string list;

     

       47
       47
       +
           method_calls: Invocation.t list;

     

       48
       48
       +
           created_ids: id id_map option;

     

       49
       49
       +
         }

     

       50
       50
       +
         

     

       51
       51
       +
         let using t = t.using

     

       52
       52
       +
         let method_calls t = t.method_calls

     

       53
       53
       +
         let created_ids t = t.created_ids

     

       54
       54
       +
         

     

       55
       55
       +
         let v ~using ~method_calls ?created_ids () =

     

       56
       56
       +
           { using; method_calls; created_ids }

     

       57
       57
       +
       end

     

       58
       58
       +
       

     

       59
       59
       +
       (* The Response object. *)

     

       60
       60
       +
       module Response = struct

     

       61
       61
       +
         type t = {

     

       62
       62
       +
           method_responses: response_invocation list;

     

       63
       63
       +
           created_ids: id id_map option;

     

       64
       64
       +
           session_state: string;

     

       65
       65
       +
         }

     

       66
       66
       +
         

     

       67
       67
       +
         let method_responses t = t.method_responses

     

       68
       68
       +
         let created_ids t = t.created_ids

     

       69
       69
       +
         let session_state t = t.session_state

     

       70
       70
       +
         

     

       71
       71
       +
         let v ~method_responses ?created_ids ~session_state () =

     

       72
       72
       +
           { method_responses; created_ids; session_state }

     

       73
       73
       +
       end

+80

jmap/jmap_wire.mli

···

       1
       1
       +
       (** JMAP Wire Protocol Structures (Request/Response). *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Jmap_types

     

       4
       4
       +
       

     

       5
       5
       +
       (** An invocation tuple within a request or response.

     

       6
       6
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.2> RFC 8620, Section 3.2 *)

     

       7
       7
       +
       module Invocation : sig

     

       8
       8
       +
         type t

     

       9
       9
       +
         

     

       10
       10
       +
         val method_name : t -> string

     

       11
       11
       +
         val arguments : t -> Yojson.Safe.t

     

       12
       12
       +
         val method_call_id : t -> string

     

       13
       13
       +
         

     

       14
       14
       +
         val v : 

     

       15
       15
       +
           ?arguments:Yojson.Safe.t ->

     

       16
       16
       +
           method_name:string ->

     

       17
       17
       +
           method_call_id:string ->

     

       18
       18
       +
           unit ->

     

       19
       19
       +
           t

     

       20
       20
       +
       end

     

       21
       21
       +
       

     

       22
       22
       +
       (** Method error type with context.

     

       23
       23
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       24
       24
       +
       type method_error = Jmap_error.Method_error.t * string

     

       25
       25
       +
       

     

       26
       26
       +
       (** A response invocation part, which can be a standard response or an error.

     

       27
       27
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4

     

       28
       28
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)

     

       29
       29
       +
       type response_invocation = (Invocation.t, method_error) result

     

       30
       30
       +
       

     

       31
       31
       +
       (** A reference to a previous method call's result.

     

       32
       32
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)

     

       33
       33
       +
       module Result_reference : sig

     

       34
       34
       +
         type t

     

       35
       35
       +
         

     

       36
       36
       +
         val result_of : t -> string

     

       37
       37
       +
         val name : t -> string

     

       38
       38
       +
         val path : t -> json_pointer

     

       39
       39
       +
         

     

       40
       40
       +
         val v :

     

       41
       41
       +
           result_of:string ->

     

       42
       42
       +
           name:string ->

     

       43
       43
       +
           path:json_pointer ->

     

       44
       44
       +
           unit ->

     

       45
       45
       +
           t

     

       46
       46
       +
       end

     

       47
       47
       +
       

     

       48
       48
       +
       (** The Request object.

     

       49
       49
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)

     

       50
       50
       +
       module Request : sig

     

       51
       51
       +
         type t

     

       52
       52
       +
         

     

       53
       53
       +
         val using : t -> string list

     

       54
       54
       +
         val method_calls : t -> Invocation.t list

     

       55
       55
       +
         val created_ids : t -> id id_map option

     

       56
       56
       +
         

     

       57
       57
       +
         val v :

     

       58
       58
       +
           using:string list ->

     

       59
       59
       +
           method_calls:Invocation.t list ->

     

       60
       60
       +
           ?created_ids:id id_map ->

     

       61
       61
       +
           unit ->

     

       62
       62
       +
           t

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       (** The Response object.

     

       66
       66
       +
           @see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 *)

     

       67
       67
       +
       module Response : sig

     

       68
       68
       +
         type t

     

       69
       69
       +
         

     

       70
       70
       +
         val method_responses : t -> response_invocation list

     

       71
       71
       +
         val created_ids : t -> id id_map option

     

       72
       72
       +
         val session_state : t -> string

     

       73
       73
       +
         

     

       74
       74
       +
         val v :

     

       75
       75
       +
           method_responses:response_invocation list ->

     

       76
       76
       +
           ?created_ids:id id_map ->

     

       77
       77
       +
           session_state:string ->

     

       78
       78
       +
           unit ->

     

       79
       79
       +
           t

     

       80
       80
       +
       end