This repository has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6let core = "urn:ietf:params:jmap:core"
7let mail = "urn:ietf:params:jmap:mail"
8let submission = "urn:ietf:params:jmap:submission"
9let vacation_response = "urn:ietf:params:jmap:vacationresponse"
10
11module Core = struct
12 type t = {
13 max_size_upload : int64;
14 max_concurrent_upload : int;
15 max_size_request : int64;
16 max_concurrent_requests : int;
17 max_calls_in_request : int;
18 max_objects_in_get : int;
19 max_objects_in_set : int;
20 collation_algorithms : string list;
21 }
22
23 let create ~max_size_upload ~max_concurrent_upload ~max_size_request
24 ~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get
25 ~max_objects_in_set ~collation_algorithms =
26 { max_size_upload; max_concurrent_upload; max_size_request;
27 max_concurrent_requests; max_calls_in_request; max_objects_in_get;
28 max_objects_in_set; collation_algorithms }
29
30 let max_size_upload t = t.max_size_upload
31 let max_concurrent_upload t = t.max_concurrent_upload
32 let max_size_request t = t.max_size_request
33 let max_concurrent_requests t = t.max_concurrent_requests
34 let max_calls_in_request t = t.max_calls_in_request
35 let max_objects_in_get t = t.max_objects_in_get
36 let max_objects_in_set t = t.max_objects_in_set
37 let collation_algorithms t = t.collation_algorithms
38
39 let make max_size_upload max_concurrent_upload max_size_request
40 max_concurrent_requests max_calls_in_request max_objects_in_get
41 max_objects_in_set collation_algorithms =
42 { max_size_upload; max_concurrent_upload; max_size_request;
43 max_concurrent_requests; max_calls_in_request; max_objects_in_get;
44 max_objects_in_set; collation_algorithms }
45
46 let jsont =
47 let kind = "Core capability" in
48 Jsont.Object.map ~kind make
49 |> Jsont.Object.mem "maxSizeUpload" Proto_int53.Unsigned.jsont ~enc:max_size_upload
50 |> Jsont.Object.mem "maxConcurrentUpload" Jsont.int ~enc:max_concurrent_upload
51 |> Jsont.Object.mem "maxSizeRequest" Proto_int53.Unsigned.jsont ~enc:max_size_request
52 |> Jsont.Object.mem "maxConcurrentRequests" Jsont.int ~enc:max_concurrent_requests
53 |> Jsont.Object.mem "maxCallsInRequest" Jsont.int ~enc:max_calls_in_request
54 |> Jsont.Object.mem "maxObjectsInGet" Jsont.int ~enc:max_objects_in_get
55 |> Jsont.Object.mem "maxObjectsInSet" Jsont.int ~enc:max_objects_in_set
56 |> Jsont.Object.mem "collationAlgorithms" (Jsont.list Jsont.string) ~enc:collation_algorithms
57 |> Jsont.Object.finish
58end
59
60module Mail = struct
61 type t = {
62 max_mailboxes_per_email : int64 option;
63 max_mailbox_depth : int64 option;
64 max_size_mailbox_name : int64;
65 max_size_attachments_per_email : int64;
66 email_query_sort_options : string list;
67 may_create_top_level_mailbox : bool;
68 }
69
70 let create ?max_mailboxes_per_email ?max_mailbox_depth ~max_size_mailbox_name
71 ~max_size_attachments_per_email ~email_query_sort_options
72 ~may_create_top_level_mailbox () =
73 { max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;
74 max_size_attachments_per_email; email_query_sort_options;
75 may_create_top_level_mailbox }
76
77 let max_mailboxes_per_email t = t.max_mailboxes_per_email
78 let max_mailbox_depth t = t.max_mailbox_depth
79 let max_size_mailbox_name t = t.max_size_mailbox_name
80 let max_size_attachments_per_email t = t.max_size_attachments_per_email
81 let email_query_sort_options t = t.email_query_sort_options
82 let may_create_top_level_mailbox t = t.may_create_top_level_mailbox
83
84 let make max_mailboxes_per_email max_mailbox_depth max_size_mailbox_name
85 max_size_attachments_per_email email_query_sort_options
86 may_create_top_level_mailbox =
87 { max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;
88 max_size_attachments_per_email; email_query_sort_options;
89 may_create_top_level_mailbox }
90
91 let jsont =
92 let kind = "Mail capability" in
93 Jsont.Object.map ~kind make
94 |> Jsont.Object.opt_mem "maxMailboxesPerEmail" Proto_int53.Unsigned.jsont ~enc:max_mailboxes_per_email
95 |> Jsont.Object.opt_mem "maxMailboxDepth" Proto_int53.Unsigned.jsont ~enc:max_mailbox_depth
96 |> Jsont.Object.mem "maxSizeMailboxName" Proto_int53.Unsigned.jsont ~enc:max_size_mailbox_name
97 |> Jsont.Object.mem "maxSizeAttachmentsPerEmail" Proto_int53.Unsigned.jsont ~enc:max_size_attachments_per_email
98 |> Jsont.Object.mem "emailQuerySortOptions" (Jsont.list Jsont.string) ~enc:email_query_sort_options
99 |> Jsont.Object.mem "mayCreateTopLevelMailbox" Jsont.bool ~enc:may_create_top_level_mailbox
100 |> Jsont.Object.finish
101end
102
103module Submission = struct
104 type t = {
105 max_delayed_send : int64;
106 submission_extensions : (string * string list) list;
107 }
108
109 let create ~max_delayed_send ~submission_extensions =
110 { max_delayed_send; submission_extensions }
111
112 let max_delayed_send t = t.max_delayed_send
113 let submission_extensions t = t.submission_extensions
114
115 let make max_delayed_send submission_extensions =
116 { max_delayed_send; submission_extensions }
117
118 let submission_extensions_jsont =
119 Proto_json_map.of_string (Jsont.list Jsont.string)
120
121 let jsont =
122 let kind = "Submission capability" in
123 Jsont.Object.map ~kind make
124 |> Jsont.Object.mem "maxDelayedSend" Proto_int53.Unsigned.jsont ~enc:max_delayed_send
125 |> Jsont.Object.mem "submissionExtensions" submission_extensions_jsont ~enc:submission_extensions
126 |> Jsont.Object.finish
127end
128
129type capability =
130 | Core of Core.t
131 | Mail of Mail.t
132 | Submission of Submission.t
133 | Vacation_response
134 | Unknown of Jsont.json
135
136let capability_of_json uri json =
137 match uri with
138 | u when u = core ->
139 (match Jsont.Json.decode' Core.jsont json with
140 | Ok c -> Core c
141 | Error _ -> Unknown json)
142 | u when u = mail ->
143 (match Jsont.Json.decode' Mail.jsont json with
144 | Ok m -> Mail m
145 | Error _ -> Unknown json)
146 | u when u = submission ->
147 (match Jsont.Json.decode' Submission.jsont json with
148 | Ok s -> Submission s
149 | Error _ -> Unknown json)
150 | u when u = vacation_response ->
151 Vacation_response
152 | _ ->
153 Unknown json
154
155let capability_to_json (uri, cap) =
156 let encode jsont v =
157 match Jsont.Json.encode' jsont v with
158 | Ok json -> json
159 | Error _ -> Jsont.Object ([], Jsont.Meta.none)
160 in
161 match cap with
162 | Core c ->
163 (uri, encode Core.jsont c)
164 | Mail m ->
165 (uri, encode Mail.jsont m)
166 | Submission s ->
167 (uri, encode Submission.jsont s)
168 | Vacation_response ->
169 (uri, Jsont.Object ([], Jsont.Meta.none))
170 | Unknown json ->
171 (uri, json)