commit 4eca2dc6d9060705964250c65cbadc22ef22a4ca · anil.recoil.org/ocaml-jmap

+2 -1

bin/fastmail_list.ml

···

       69
       69
        
             | Ok conn ->

     

       70
       70
        
                 (* Get the primary account ID *)

     

       71
       71
        
                 let primary_account_id = 

     

       72
       72
       -
                   match List.assoc_opt "urn:ietf:params:jmap:mail" conn.session.primary_accounts with

     

       72
       72
       +
                   let mail_capability = Jmap_mail.Capability.to_string (Jmap_mail.Capability.Mail Mail) in

     

       73
       73
       +
                   match List.assoc_opt mail_capability conn.session.primary_accounts with

     

       73
       74
        
                   | Some id -> id

     

       74
       75
        
                   | None -> 

     

       75
       76
        
                       match conn.session.accounts with

+49

lib/jmap.ml

···

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

     

       4
       4
        
        *)

     

       5
       5
        
       

     

       6
       6
       +
       (** Module for managing JMAP capability URIs and other constants *)

     

       7
       7
       +
       module Capability = struct

     

       8
       8
       +
         (** Core JMAP capability URI *)

     

       9
       9
       +
         type core = Core

     

       10
       10
       +
       

     

       11
       11
       +
         (** JMAP capability URI as specified in RFC8620 *)

     

       12
       12
       +
         let core_uri = "urn:ietf:params:jmap:core"

     

       13
       13
       +
       

     

       14
       14
       +
         (** Convert core capability to URI string *)

     

       15
       15
       +
         let string_of_core = function

     

       16
       16
       +
           | Core -> core_uri

     

       17
       17
       +
       

     

       18
       18
       +
         (** Parse a string to a core capability, returns None if not a valid capability URI *)

     

       19
       19
       +
         let core_of_string = function

     

       20
       20
       +
           | s when s = core_uri -> Some Core

     

       21
       21
       +
           | _ -> None

     

       22
       22
       +
       

     

       23
       23
       +
         (** All JMAP capability types *)

     

       24
       24
       +
         type t = 

     

       25
       25
       +
           | Core of core

     

       26
       26
       +
           | Extension of string

     

       27
       27
       +
       

     

       28
       28
       +
         (** Convert capability to URI string *)

     

       29
       29
       +
         let to_string = function

     

       30
       30
       +
           | Core c -> string_of_core c

     

       31
       31
       +
           | Extension s -> s

     

       32
       32
       +
       

     

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

     

       34
       34
       +
         let of_string s =

     

       35
       35
       +
           match core_of_string s with

     

       36
       36
       +
           | Some c -> Core c

     

       37
       37
       +
           | None -> Extension s

     

       38
       38
       +
           

     

       39
       39
       +
         (** Check if a capability matches a core capability *)

     

       40
       40
       +
         let is_core = function

     

       41
       41
       +
           | Core _ -> true

     

       42
       42
       +
           | Extension _ -> false

     

       43
       43
       +
       

     

       44
       44
       +
         (** Check if a capability string is a core capability *)

     

       45
       45
       +
         let is_core_string s =

     

       46
       46
       +
           match of_string s with

     

       47
       47
       +
           | Core _ -> true

     

       48
       48
       +
           | Extension _ -> false

     

       49
       49
       +
       

     

       50
       50
       +
         (** Create a list of capability strings *)

     

       51
       51
       +
         let strings_of_capabilities capabilities =

     

       52
       52
       +
           List.map to_string capabilities

     

       53
       53
       +
       end

     

       54
       54
       +
       

     

       6
       55
        
       module Types = struct

     

       7
       56
        
         (** Id string as per Section 1.2 *)

     

       8
       57
        
         type id = string

+35

lib/jmap.mli

···

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

     

       4
       4
        
        *)

     

       5
       5
        
       

     

       6
       6
       +
       (** Module for managing JMAP capability URIs and other constants *)

     

       7
       7
       +
       module Capability : sig

     

       8
       8
       +
         (** Core JMAP capability URI *)

     

       9
       9
       +
         type core = Core

     

       10
       10
       +
       

     

       11
       11
       +
         (** JMAP capability URI as specified in RFC8620 *)

     

       12
       12
       +
         val core_uri : string

     

       13
       13
       +
       

     

       14
       14
       +
         (** Convert core capability to URI string *)

     

       15
       15
       +
         val string_of_core : core -> string

     

       16
       16
       +
       

     

       17
       17
       +
         (** Parse a string to a core capability, returns None if not a valid capability URI *)

     

       18
       18
       +
         val core_of_string : string -> core option

     

       19
       19
       +
       

     

       20
       20
       +
         (** All JMAP capability types *)

     

       21
       21
       +
         type t = 

     

       22
       22
       +
           | Core of core

     

       23
       23
       +
           | Extension of string

     

       24
       24
       +
       

     

       25
       25
       +
         (** Convert capability to URI string *)

     

       26
       26
       +
         val to_string : t -> string

     

       27
       27
       +
       

     

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

     

       29
       29
       +
         val of_string : string -> t

     

       30
       30
       +
           

     

       31
       31
       +
         (** Check if a capability matches a core capability *)

     

       32
       32
       +
         val is_core : t -> bool

     

       33
       33
       +
       

     

       34
       34
       +
         (** Check if a capability string is a core capability *)

     

       35
       35
       +
         val is_core_string : string -> bool

     

       36
       36
       +
       

     

       37
       37
       +
         (** Create a list of capability strings *)

     

       38
       38
       +
         val strings_of_capabilities : t list -> string list

     

       39
       39
       +
       end

     

       40
       40
       +
       

     

       6
       41
        
       (** {1 Types} *)

     

       7
       42
        
       

     

       8
       43
        
       module Types : sig

+112 -8

lib/jmap_mail.ml

···

       1
       1
        
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 *)

     

       2
       2
        
       

     

       3
       3
       +
       (** Module for managing JMAP Mail-specific capability URIs *)

     

       4
       4
       +
       module Capability = struct

     

       5
       5
       +
         (** Mail capability types *)

     

       6
       6
       +
         type mail = Mail

     

       7
       7
       +
       

     

       8
       8
       +
         (** Mail capability URI *)

     

       9
       9
       +
         let mail_uri = "urn:ietf:params:jmap:mail"

     

       10
       10
       +
       

     

       11
       11
       +
         (** Convert mail capability to URI string *)

     

       12
       12
       +
         let string_of_mail = function

     

       13
       13
       +
           | Mail -> mail_uri

     

       14
       14
       +
       

     

       15
       15
       +
         (** Parse a string to mail capability *)

     

       16
       16
       +
         let mail_of_string = function

     

       17
       17
       +
           | s when s = mail_uri -> Some Mail

     

       18
       18
       +
           | _ -> None

     

       19
       19
       +
       

     

       20
       20
       +
         (** Submission capability types *)

     

       21
       21
       +
         type submission = Submission

     

       22
       22
       +
       

     

       23
       23
       +
         (** Submission capability URI *)

     

       24
       24
       +
         let submission_uri = "urn:ietf:params:jmap:submission"

     

       25
       25
       +
       

     

       26
       26
       +
         (** Convert submission capability to URI string *)

     

       27
       27
       +
         let string_of_submission = function

     

       28
       28
       +
           | Submission -> submission_uri

     

       29
       29
       +
       

     

       30
       30
       +
         (** Parse a string to submission capability *)

     

       31
       31
       +
         let submission_of_string = function

     

       32
       32
       +
           | s when s = submission_uri -> Some Submission

     

       33
       33
       +
           | _ -> None

     

       34
       34
       +
       

     

       35
       35
       +
         (** Vacation response capability types *)

     

       36
       36
       +
         type vacation_response = VacationResponse

     

       37
       37
       +
       

     

       38
       38
       +
         (** Vacation response capability URI *)

     

       39
       39
       +
         let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"

     

       40
       40
       +
       

     

       41
       41
       +
         (** Convert vacation response capability to URI string *)

     

       42
       42
       +
         let string_of_vacation_response = function

     

       43
       43
       +
           | VacationResponse -> vacation_response_uri

     

       44
       44
       +
       

     

       45
       45
       +
         (** Parse a string to vacation response capability *)

     

       46
       46
       +
         let vacation_response_of_string = function

     

       47
       47
       +
           | s when s = vacation_response_uri -> Some VacationResponse

     

       48
       48
       +
           | _ -> None

     

       49
       49
       +
       

     

       50
       50
       +
         (** All mail extension capability types *)

     

       51
       51
       +
         type t =

     

       52
       52
       +
           | Mail of mail

     

       53
       53
       +
           | Submission of submission

     

       54
       54
       +
           | VacationResponse of vacation_response

     

       55
       55
       +
           | Extension of string

     

       56
       56
       +
       

     

       57
       57
       +
         (** Convert capability to URI string *)

     

       58
       58
       +
         let to_string = function

     

       59
       59
       +
           | Mail m -> string_of_mail m

     

       60
       60
       +
           | Submission s -> string_of_submission s

     

       61
       61
       +
           | VacationResponse v -> string_of_vacation_response v

     

       62
       62
       +
           | Extension s -> s

     

       63
       63
       +
       

     

       64
       64
       +
         (** Parse a string to a capability *)

     

       65
       65
       +
         let of_string s =

     

       66
       66
       +
           match mail_of_string s with

     

       67
       67
       +
           | Some m -> Mail m

     

       68
       68
       +
           | None ->

     

       69
       69
       +
               match submission_of_string s with

     

       70
       70
       +
               | Some s -> Submission s

     

       71
       71
       +
               | None ->

     

       72
       72
       +
                   match vacation_response_of_string s with

     

       73
       73
       +
                   | Some v -> VacationResponse v

     

       74
       74
       +
                   | None -> Extension s

     

       75
       75
       +
       

     

       76
       76
       +
         (** Check if a capability is a standard mail capability *)

     

       77
       77
       +
         let is_standard = function

     

       78
       78
       +
           | Mail _ | Submission _ | VacationResponse _ -> true

     

       79
       79
       +
           | Extension _ -> false

     

       80
       80
       +
       

     

       81
       81
       +
         (** Check if a capability string is a standard mail capability *)

     

       82
       82
       +
         let is_standard_string s =

     

       83
       83
       +
           match of_string s with

     

       84
       84
       +
           | Extension _ -> false

     

       85
       85
       +
           | _ -> true

     

       86
       86
       +
       

     

       87
       87
       +
         (** Create a list of capability strings *)

     

       88
       88
       +
         let strings_of_capabilities capabilities =

     

       89
       89
       +
           List.map to_string capabilities

     

       90
       90
       +
       end

     

       91
       91
       +
       

     

       3
       92
        
       module Types = struct

     

       4
       93
        
         open Jmap.Types

     

       5
       94
        
       

     

       6
       95
        
         (** {1 Mail capabilities} *)

     

       7
       96
        
       

     

       8
       97
        
         (** Capability URI for JMAP Mail*)

     

       9
       9
       -
         let capability_mail = "urn:ietf:params:jmap:mail"

     

       98
       98
       +
         let capability_mail = Capability.mail_uri

     

       10
       99
        
       

     

       11
       100
        
         (** Capability URI for JMAP Submission *)

     

       12
       12
       -
         let capability_submission = "urn:ietf:params:jmap:submission"

     

       101
       101
       +
         let capability_submission = Capability.submission_uri

     

       13
       102
        
         

     

       14
       103
        
         (** Capability URI for JMAP Vacation Response *)

     

       15
       15
       -
         let capability_vacation_response = "urn:ietf:params:jmap:vacationresponse"

     

       104
       104
       +
         let capability_vacation_response = Capability.vacation_response_uri

     

       16
       105
        
       

     

       17
       106
        
         (** {1:mailbox Mailbox objects} *)

     

       18
       107
        
       

     
···

       1207
       1296
        
           TODO:claude *)

     

       1208
       1297
        
       let get_mailboxes conn ~account_id =

     

       1209
       1298
        
         let request = {

     

       1210
       1210
       -
           using = ["urn:ietf:params:jmap:core"; Types.capability_mail];

     

       1299
       1299
       +
           using = [

     

       1300
       1300
       +
             Jmap.Capability.to_string (Jmap.Capability.Core Core);

     

       1301
       1301
       +
             Capability.to_string (Capability.Mail Mail)

     

       1302
       1302
       +
           ];

     

       1211
       1303
        
           method_calls = [

     

       1212
       1304
        
             {

     

       1213
       1305
        
               name = "Mailbox/get";

     
···

       1253
       1345
        
           TODO:claude *)

     

       1254
       1346
        
       let get_mailbox conn ~account_id ~mailbox_id =

     

       1255
       1347
        
         let request = {

     

       1256
       1256
       -
           using = ["urn:ietf:params:jmap:core"; Types.capability_mail];

     

       1348
       1348
       +
           using = [

     

       1349
       1349
       +
             Jmap.Capability.to_string (Jmap.Capability.Core Core);

     

       1350
       1350
       +
             Capability.to_string (Capability.Mail Mail)

     

       1351
       1351
       +
           ];

     

       1257
       1352
        
           method_calls = [

     

       1258
       1353
        
             {

     

       1259
       1354
        
               name = "Mailbox/get";

     
···

       1297
       1392
        
       let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =

     

       1298
       1393
        
         (* First query the emails in the mailbox *)

     

       1299
       1394
        
         let query_request = {

     

       1300
       1300
       -
           using = ["urn:ietf:params:jmap:core"; Types.capability_mail];

     

       1395
       1395
       +
           using = [

     

       1396
       1396
       +
             Jmap.Capability.to_string (Jmap.Capability.Core Core);

     

       1397
       1397
       +
             Capability.to_string (Capability.Mail Mail)

     

       1398
       1398
       +
           ];

     

       1301
       1399
        
           method_calls = [

     

       1302
       1400
        
             {

     

       1303
       1401
        
               name = "Email/query";

     
···

       1332
       1430
        
                    (* If we have IDs, fetch the actual email objects *)

     

       1333
       1431
        
                    if List.length email_ids > 0 then

     

       1334
       1432
        
                      let get_request = {

     

       1335
       1335
       -
                        using = ["urn:ietf:params:jmap:core"; Types.capability_mail];

     

       1433
       1433
       +
                        using = [

     

       1434
       1434
       +
                          Jmap.Capability.to_string (Jmap.Capability.Core Core);

     

       1435
       1435
       +
                          Capability.to_string (Capability.Mail Mail)

     

       1436
       1436
       +
                        ];

     

       1336
       1437
        
                        method_calls = [

     

       1337
       1438
        
                          {

     

       1338
       1439
        
                            name = "Email/get";

     
···

       1386
       1487
        
           TODO:claude *)

     

       1387
       1488
        
       let get_email conn ~account_id ~email_id =

     

       1388
       1489
        
         let request = {

     

       1389
       1389
       -
           using = ["urn:ietf:params:jmap:core"; Types.capability_mail];

     

       1490
       1490
       +
           using = [

     

       1491
       1491
       +
             Jmap.Capability.to_string (Jmap.Capability.Core Core);

     

       1492
       1492
       +
             Capability.to_string (Capability.Mail Mail)

     

       1493
       1493
       +
           ];

     

       1390
       1494
        
           method_calls = [

     

       1391
       1495
        
             {

     

       1392
       1496
        
               name = "Email/get";

+61

lib/jmap_mail.mli

···

       1
       1
        
       (** Implementation of the JMAP Mail extension, as defined in RFC8621 *)

     

       2
       2
        
       

     

       3
       3
       +
       (** Module for managing JMAP Mail-specific capability URIs *)

     

       4
       4
       +
       module Capability : sig

     

       5
       5
       +
         (** Mail capability types *)

     

       6
       6
       +
         type mail = Mail

     

       7
       7
       +
       

     

       8
       8
       +
         (** Mail capability URI *)

     

       9
       9
       +
         val mail_uri : string

     

       10
       10
       +
       

     

       11
       11
       +
         (** Convert mail capability to URI string *)

     

       12
       12
       +
         val string_of_mail : mail -> string

     

       13
       13
       +
       

     

       14
       14
       +
         (** Parse a string to mail capability *)

     

       15
       15
       +
         val mail_of_string : string -> mail option

     

       16
       16
       +
       

     

       17
       17
       +
         (** Submission capability types *)

     

       18
       18
       +
         type submission = Submission

     

       19
       19
       +
       

     

       20
       20
       +
         (** Submission capability URI *)

     

       21
       21
       +
         val submission_uri : string

     

       22
       22
       +
       

     

       23
       23
       +
         (** Convert submission capability to URI string *)

     

       24
       24
       +
         val string_of_submission : submission -> string

     

       25
       25
       +
       

     

       26
       26
       +
         (** Parse a string to submission capability *)

     

       27
       27
       +
         val submission_of_string : string -> submission option

     

       28
       28
       +
       

     

       29
       29
       +
         (** Vacation response capability types *)

     

       30
       30
       +
         type vacation_response = VacationResponse

     

       31
       31
       +
       

     

       32
       32
       +
         (** Vacation response capability URI *)

     

       33
       33
       +
         val vacation_response_uri : string

     

       34
       34
       +
       

     

       35
       35
       +
         (** Convert vacation response capability to URI string *)

     

       36
       36
       +
         val string_of_vacation_response : vacation_response -> string

     

       37
       37
       +
       

     

       38
       38
       +
         (** Parse a string to vacation response capability *)

     

       39
       39
       +
         val vacation_response_of_string : string -> vacation_response option

     

       40
       40
       +
       

     

       41
       41
       +
         (** All mail extension capability types *)

     

       42
       42
       +
         type t =

     

       43
       43
       +
           | Mail of mail

     

       44
       44
       +
           | Submission of submission

     

       45
       45
       +
           | VacationResponse of vacation_response

     

       46
       46
       +
           | Extension of string

     

       47
       47
       +
       

     

       48
       48
       +
         (** Convert capability to URI string *)

     

       49
       49
       +
         val to_string : t -> string

     

       50
       50
       +
       

     

       51
       51
       +
         (** Parse a string to a capability *)

     

       52
       52
       +
         val of_string : string -> t

     

       53
       53
       +
       

     

       54
       54
       +
         (** Check if a capability is a standard mail capability *)

     

       55
       55
       +
         val is_standard : t -> bool

     

       56
       56
       +
       

     

       57
       57
       +
         (** Check if a capability string is a standard mail capability *)

     

       58
       58
       +
         val is_standard_string : string -> bool

     

       59
       59
       +
       

     

       60
       60
       +
         (** Create a list of capability strings *)

     

       61
       61
       +
         val strings_of_capabilities : t list -> string list

     

       62
       62
       +
       end

     

       63
       63
       +
       

     

       3
       64
        
       (** Types for the JMAP Mail extension *)

     

       4
       65
        
       module Types : sig

     

       5
       66
        
         open Jmap.Types