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