-300

jmap-email/jmap_email.ml

Reviewed

··· 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

-405

jmap-email/jmap_email_types.ml

Reviewed

··· 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 - ]

-130

jmap-email/jmap_identity.ml

Reviewed

··· 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

-282

jmap-email/jmap_mailbox.ml

Reviewed

··· 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

-9

jmap-email/jmap_search_snippet.ml

Reviewed

··· 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 - }

-125

jmap-email/jmap_submission.ml

Reviewed

··· 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

-19

jmap-email/jmap_thread.ml

Reviewed

··· 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

-103

jmap-email/jmap_vacation.ml

Reviewed

··· 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

-672

jmap-unix/jmap_unix.ml

Reviewed

··· 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

-45

jmap/jmap.ml

Reviewed

··· 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

-56

jmap/jmap_binary.ml

Reviewed

··· 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

-266

jmap/jmap_error.ml

Reviewed

··· 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

-436

jmap/jmap_methods.ml

Reviewed

··· 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

-192

jmap/jmap_push.ml

Reviewed

··· 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

-114

jmap/jmap_session.ml

Reviewed

··· 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 - ()

-32

jmap/jmap_types.ml

Reviewed

··· 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

-73

jmap/jmap_wire.ml

Reviewed

··· 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