My agentic slop goes here. Not intended for anyone else!
1(** JMAP Error Types and Exception Handling
2
3 This module defines all error types from RFC 8620 (Core JMAP Protocol)
4 and RFC 8621 (JMAP for Mail).
5
6 Reference: RFC 8620 Section 3.6 (Error Handling)
7 Test files: test/data/core/error_method.json
8*)
9
10(** Error classification level *)
11type error_level =
12 | Request_level (** HTTP 4xx/5xx errors before request processing *)
13 | Method_level (** Method execution errors *)
14 | Set_level (** Object-level errors in /set operations *)
15
16(** Request-level errors (RFC 8620 Section 3.6.1)
17 These return HTTP error responses with JSON problem details (RFC 7807) *)
18type request_error =
19 | Unknown_capability of string (** Unsupported capability in "using" *)
20 | Not_json (** Not application/json or invalid I-JSON *)
21 | Not_request (** JSON doesn't match Request type *)
22 | Limit of string (** Request limit exceeded, includes limit property name *)
23
24(** Method-level errors (RFC 8620 Section 3.6.2)
25 These return error Invocations in methodResponses *)
26type method_error =
27 (* General method errors *)
28 | Server_unavailable (** Temporary server issue, retry later *)
29 | Server_fail of string option (** Unexpected error, includes description *)
30 | Server_partial_fail (** Some changes succeeded, must resync *)
31 | Unknown_method (** Method name not recognized *)
32 | Invalid_arguments of string option (** Invalid/missing arguments *)
33 | Invalid_result_reference (** Result reference failed to resolve *)
34 | Forbidden (** ACL/permission violation *)
35 | Account_not_found (** Invalid accountId *)
36 | Account_not_supported_by_method (** Account doesn't support this method *)
37 | Account_read_only (** Account is read-only *)
38
39 (* Standard method-specific errors *)
40 | Request_too_large (** Too many ids/operations requested *)
41 | State_mismatch (** ifInState doesn't match current state *)
42 | Cannot_calculate_changes (** Server cannot calculate changes from state *)
43 | Anchor_not_found (** Anchor id not in query results *)
44 | Unsupported_sort (** Sort property/collation not supported *)
45 | Unsupported_filter (** Filter cannot be processed *)
46 | Too_many_changes (** More changes than maxChanges *)
47
48 (* /copy specific errors *)
49 | From_account_not_found (** Source account not found *)
50 | From_account_not_supported_by_method (** Source account doesn't support type *)
51
52(** Set-level errors (RFC 8620 Section 5.3)
53 These appear in notCreated, notUpdated, notDestroyed maps *)
54type set_error_type =
55 (* Core set errors *)
56 | Forbidden (** Permission denied *)
57 | Over_quota (** Quota exceeded *)
58 | Too_large (** Object too large *)
59 | Rate_limit (** Rate limit hit *)
60 | Not_found (** Id not found *)
61 | Invalid_patch (** Invalid PatchObject *)
62 | Will_destroy (** Object both updated and destroyed *)
63 | Invalid_properties (** Invalid properties *)
64 | Singleton (** Cannot create/destroy singleton *)
65 | Already_exists (** Duplicate exists (in /copy) *)
66
67 (* Mail-specific set errors (RFC 8621) *)
68 | Mailbox_has_child (** Cannot destroy mailbox with children *)
69 | Mailbox_has_email (** Cannot destroy mailbox with emails *)
70 | Blob_not_found (** Referenced blob doesn't exist *)
71 | Too_many_keywords (** Keyword limit exceeded *)
72 | Too_many_mailboxes (** Mailbox assignment limit exceeded *)
73 | Invalid_email (** Email invalid for sending *)
74 | Too_many_recipients (** Recipient limit exceeded *)
75 | No_recipients (** No recipients specified *)
76 | Invalid_recipients (** Invalid recipient addresses *)
77 | Forbidden_mail_from (** Cannot use MAIL FROM address *)
78 | Forbidden_from (** Cannot use From header address *)
79 | Forbidden_to_send (** No send permission *)
80 | Cannot_unsend (** Cannot cancel submission *)
81
82(** SetError detail with optional fields *)
83type set_error_detail = {
84 error_type : set_error_type;
85 description : string option;
86 properties : string list option; (** For Invalid_properties *)
87 existing_id : string option; (** For Already_exists *)
88 not_found : string list option; (** For Blob_not_found *)
89 max_recipients : int option; (** For Too_many_recipients *)
90 invalid_recipients : string list option; (** For Invalid_recipients *)
91}
92
93(** Main JMAP exception type *)
94exception Jmap_error of error_level * string * string option
95
96(** Parse error for JSON parsing failures *)
97exception Parse_error of string
98
99(** Helper constructors for exceptions *)
100
101let request_error err =
102 let msg = match err with
103 | Unknown_capability cap -> Printf.sprintf "Unknown capability: %s" cap
104 | Not_json -> "Request is not valid JSON"
105 | Not_request -> "JSON does not match Request structure"
106 | Limit prop -> Printf.sprintf "Request limit exceeded: %s" prop
107 in
108 Jmap_error (Request_level, msg, None)
109
110let method_error err =
111 let msg, desc = match err with
112 | Server_unavailable -> "serverUnavailable", None
113 | Server_fail desc -> "serverFail", desc
114 | Server_partial_fail -> "serverPartialFail", None
115 | Unknown_method -> "unknownMethod", None
116 | Invalid_arguments desc -> "invalidArguments", desc
117 | Invalid_result_reference -> "invalidResultReference", None
118 | Forbidden -> "forbidden", None
119 | Account_not_found -> "accountNotFound", None
120 | Account_not_supported_by_method -> "accountNotSupportedByMethod", None
121 | Account_read_only -> "accountReadOnly", None
122 | Request_too_large -> "requestTooLarge", None
123 | State_mismatch -> "stateMismatch", None
124 | Cannot_calculate_changes -> "cannotCalculateChanges", None
125 | Anchor_not_found -> "anchorNotFound", None
126 | Unsupported_sort -> "unsupportedSort", None
127 | Unsupported_filter -> "unsupportedFilter", None
128 | Too_many_changes -> "tooManyChanges", None
129 | From_account_not_found -> "fromAccountNotFound", None
130 | From_account_not_supported_by_method -> "fromAccountNotSupportedByMethod", None
131 in
132 Jmap_error (Method_level, msg, desc)
133
134let set_error detail =
135 let msg = match detail.error_type with
136 | Forbidden -> "forbidden"
137 | Over_quota -> "overQuota"
138 | Too_large -> "tooLarge"
139 | Rate_limit -> "rateLimit"
140 | Not_found -> "notFound"
141 | Invalid_patch -> "invalidPatch"
142 | Will_destroy -> "willDestroy"
143 | Invalid_properties -> "invalidProperties"
144 | Singleton -> "singleton"
145 | Already_exists -> "alreadyExists"
146 | Mailbox_has_child -> "mailboxHasChild"
147 | Mailbox_has_email -> "mailboxHasEmail"
148 | Blob_not_found -> "blobNotFound"
149 | Too_many_keywords -> "tooManyKeywords"
150 | Too_many_mailboxes -> "tooManyMailboxes"
151 | Invalid_email -> "invalidEmail"
152 | Too_many_recipients -> "tooManyRecipients"
153 | No_recipients -> "noRecipients"
154 | Invalid_recipients -> "invalidRecipients"
155 | Forbidden_mail_from -> "forbiddenMailFrom"
156 | Forbidden_from -> "forbiddenFrom"
157 | Forbidden_to_send -> "forbiddenToSend"
158 | Cannot_unsend -> "cannotUnsend"
159 in
160 Jmap_error (Set_level, msg, detail.description)
161
162let parse_error msg =
163 Parse_error msg
164
165(** Convert error type to string for serialization *)
166let request_error_to_string = function
167 | Unknown_capability _ -> "urn:ietf:params:jmap:error:unknownCapability"
168 | Not_json -> "urn:ietf:params:jmap:error:notJSON"
169 | Not_request -> "urn:ietf:params:jmap:error:notRequest"
170 | Limit _ -> "urn:ietf:params:jmap:error:limit"
171
172let method_error_to_string = function
173 | Server_unavailable -> "serverUnavailable"
174 | Server_fail _ -> "serverFail"
175 | Server_partial_fail -> "serverPartialFail"
176 | Unknown_method -> "unknownMethod"
177 | Invalid_arguments _ -> "invalidArguments"
178 | Invalid_result_reference -> "invalidResultReference"
179 | Forbidden -> "forbidden"
180 | Account_not_found -> "accountNotFound"
181 | Account_not_supported_by_method -> "accountNotSupportedByMethod"
182 | Account_read_only -> "accountReadOnly"
183 | Request_too_large -> "requestTooLarge"
184 | State_mismatch -> "stateMismatch"
185 | Cannot_calculate_changes -> "cannotCalculateChanges"
186 | Anchor_not_found -> "anchorNotFound"
187 | Unsupported_sort -> "unsupportedSort"
188 | Unsupported_filter -> "unsupportedFilter"
189 | Too_many_changes -> "tooManyChanges"
190 | From_account_not_found -> "fromAccountNotFound"
191 | From_account_not_supported_by_method -> "fromAccountNotSupportedByMethod"
192
193let set_error_type_to_string = function
194 | Forbidden -> "forbidden"
195 | Over_quota -> "overQuota"
196 | Too_large -> "tooLarge"
197 | Rate_limit -> "rateLimit"
198 | Not_found -> "notFound"
199 | Invalid_patch -> "invalidPatch"
200 | Will_destroy -> "willDestroy"
201 | Invalid_properties -> "invalidProperties"
202 | Singleton -> "singleton"
203 | Already_exists -> "alreadyExists"
204 | Mailbox_has_child -> "mailboxHasChild"
205 | Mailbox_has_email -> "mailboxHasEmail"
206 | Blob_not_found -> "blobNotFound"
207 | Too_many_keywords -> "tooManyKeywords"
208 | Too_many_mailboxes -> "tooManyMailboxes"
209 | Invalid_email -> "invalidEmail"
210 | Too_many_recipients -> "tooManyRecipients"
211 | No_recipients -> "noRecipients"
212 | Invalid_recipients -> "invalidRecipients"
213 | Forbidden_mail_from -> "forbiddenMailFrom"
214 | Forbidden_from -> "forbiddenFrom"
215 | Forbidden_to_send -> "forbiddenToSend"
216 | Cannot_unsend -> "cannotUnsend"
217
218let set_error_type_of_string = function
219 | "forbidden" -> Forbidden
220 | "overQuota" -> Over_quota
221 | "tooLarge" -> Too_large
222 | "rateLimit" -> Rate_limit
223 | "notFound" -> Not_found
224 | "invalidPatch" -> Invalid_patch
225 | "willDestroy" -> Will_destroy
226 | "invalidProperties" -> Invalid_properties
227 | "singleton" -> Singleton
228 | "alreadyExists" -> Already_exists
229 | "mailboxHasChild" -> Mailbox_has_child
230 | "mailboxHasEmail" -> Mailbox_has_email
231 | "blobNotFound" -> Blob_not_found
232 | "tooManyKeywords" -> Too_many_keywords
233 | "tooManyMailboxes" -> Too_many_mailboxes
234 | "invalidEmail" -> Invalid_email
235 | "tooManyRecipients" -> Too_many_recipients
236 | "noRecipients" -> No_recipients
237 | "invalidRecipients" -> Invalid_recipients
238 | "forbiddenMailFrom" -> Forbidden_mail_from
239 | "forbiddenFrom" -> Forbidden_from
240 | "forbiddenToSend" -> Forbidden_to_send
241 | "cannotUnsend" -> Cannot_unsend
242 | s -> raise (Parse_error (Printf.sprintf "Unknown set error type: %s" s))
243
244(** Parse set_error_detail from JSON *)
245let parse_set_error_detail json =
246 match json with
247 | `O fields ->
248 let error_type = match List.assoc_opt "type" fields with
249 | Some (`String s) -> set_error_type_of_string s
250 | Some _ -> raise (Parse_error "SetError type must be a string")
251 | None -> raise (Parse_error "SetError requires 'type' field")
252 in
253 let description = match List.assoc_opt "description" fields with
254 | Some (`String s) -> Some s
255 | Some `Null | None -> None
256 | Some _ -> raise (Parse_error "SetError description must be a string")
257 in
258 let properties = match List.assoc_opt "properties" fields with
259 | Some (`A items) ->
260 Some (List.map (function
261 | `String s -> s
262 | _ -> raise (Parse_error "SetError properties must be strings")
263 ) items)
264 | Some `Null | None -> None
265 | Some _ -> raise (Parse_error "SetError properties must be an array")
266 in
267 let existing_id = match List.assoc_opt "existingId" fields with
268 | Some (`String s) -> Some s
269 | Some `Null | None -> None
270 | Some _ -> raise (Parse_error "SetError existingId must be a string")
271 in
272 let not_found = match List.assoc_opt "notFound" fields with
273 | Some (`A items) ->
274 Some (List.map (function
275 | `String s -> s
276 | _ -> raise (Parse_error "SetError notFound must be strings")
277 ) items)
278 | Some `Null | None -> None
279 | Some _ -> raise (Parse_error "SetError notFound must be an array")
280 in
281 let max_recipients = match List.assoc_opt "maxRecipients" fields with
282 | Some (`Float f) -> Some (int_of_float f)
283 | Some `Null | None -> None
284 | Some _ -> raise (Parse_error "SetError maxRecipients must be a number")
285 in
286 let invalid_recipients = match List.assoc_opt "invalidRecipients" fields with
287 | Some (`A items) ->
288 Some (List.map (function
289 | `String s -> s
290 | _ -> raise (Parse_error "SetError invalidRecipients must be strings")
291 ) items)
292 | Some `Null | None -> None
293 | Some _ -> raise (Parse_error "SetError invalidRecipients must be an array")
294 in
295 { error_type; description; properties; existing_id; not_found;
296 max_recipients; invalid_recipients }
297 | _ -> raise (Parse_error "SetError must be a JSON object")