jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Jmap_proto
7
8(* Phantom types for handle kinds *)
9type query
10type get
11type changes
12type set
13type query_changes
14type copy
15type import
16type parse
17
18(* Internal handle representation with GADT for response type *)
19type (_, _) handle =
20 | Query_handle : {
21 call_id : string;
22 method_name : string;
23 } -> (query, Method.query_response) handle
24 | Query_changes_handle : {
25 call_id : string;
26 method_name : string;
27 } -> (query_changes, Method.query_changes_response) handle
28 | Email_get_handle : {
29 call_id : string;
30 method_name : string;
31 } -> (get, Email.t Method.get_response) handle
32 | Thread_get_handle : {
33 call_id : string;
34 method_name : string;
35 } -> (get, Thread.t Method.get_response) handle
36 | Mailbox_get_handle : {
37 call_id : string;
38 method_name : string;
39 } -> (get, Mailbox.t Method.get_response) handle
40 | Identity_get_handle : {
41 call_id : string;
42 method_name : string;
43 } -> (get, Identity.t Method.get_response) handle
44 | Submission_get_handle : {
45 call_id : string;
46 method_name : string;
47 } -> (get, Submission.t Method.get_response) handle
48 | Search_snippet_get_handle : {
49 call_id : string;
50 method_name : string;
51 } -> (get, Search_snippet.t Method.get_response) handle
52 | Vacation_get_handle : {
53 call_id : string;
54 method_name : string;
55 } -> (get, Vacation.t Method.get_response) handle
56 | Changes_handle : {
57 call_id : string;
58 method_name : string;
59 } -> (changes, Method.changes_response) handle
60 | Email_set_handle : {
61 call_id : string;
62 method_name : string;
63 } -> (set, Email.t Method.set_response) handle
64 | Mailbox_set_handle : {
65 call_id : string;
66 method_name : string;
67 } -> (set, Mailbox.t Method.set_response) handle
68 | Identity_set_handle : {
69 call_id : string;
70 method_name : string;
71 } -> (set, Identity.t Method.set_response) handle
72 | Submission_set_handle : {
73 call_id : string;
74 method_name : string;
75 } -> (set, Submission.t Method.set_response) handle
76 | Vacation_set_handle : {
77 call_id : string;
78 method_name : string;
79 } -> (set, Vacation.t Method.set_response) handle
80 | Email_copy_handle : {
81 call_id : string;
82 method_name : string;
83 } -> (copy, Email.t Method.copy_response) handle
84 | Raw_handle : {
85 call_id : string;
86 method_name : string;
87 } -> (unit, Jsont.Json.t) handle
88
89let call_id : type k r. (k, r) handle -> string = function
90 | Query_handle h -> h.call_id
91 | Query_changes_handle h -> h.call_id
92 | Email_get_handle h -> h.call_id
93 | Thread_get_handle h -> h.call_id
94 | Mailbox_get_handle h -> h.call_id
95 | Identity_get_handle h -> h.call_id
96 | Submission_get_handle h -> h.call_id
97 | Search_snippet_get_handle h -> h.call_id
98 | Vacation_get_handle h -> h.call_id
99 | Changes_handle h -> h.call_id
100 | Email_set_handle h -> h.call_id
101 | Mailbox_set_handle h -> h.call_id
102 | Identity_set_handle h -> h.call_id
103 | Submission_set_handle h -> h.call_id
104 | Vacation_set_handle h -> h.call_id
105 | Email_copy_handle h -> h.call_id
106 | Raw_handle h -> h.call_id
107
108let method_name : type k r. (k, r) handle -> string = function
109 | Query_handle h -> h.method_name
110 | Query_changes_handle h -> h.method_name
111 | Email_get_handle h -> h.method_name
112 | Thread_get_handle h -> h.method_name
113 | Mailbox_get_handle h -> h.method_name
114 | Identity_get_handle h -> h.method_name
115 | Submission_get_handle h -> h.method_name
116 | Search_snippet_get_handle h -> h.method_name
117 | Vacation_get_handle h -> h.method_name
118 | Changes_handle h -> h.method_name
119 | Email_set_handle h -> h.method_name
120 | Mailbox_set_handle h -> h.method_name
121 | Identity_set_handle h -> h.method_name
122 | Submission_set_handle h -> h.method_name
123 | Vacation_set_handle h -> h.method_name
124 | Email_copy_handle h -> h.method_name
125 | Raw_handle h -> h.method_name
126
127(* Creation IDs *)
128type 'a create_id = string
129
130let created_id cid = Id.of_string_exn ("#" ^ cid)
131let created_id_of_string s = Id.of_string_exn ("#" ^ s)
132
133(* ID sources *)
134type id_source =
135 | Ids of Id.t list
136 | Ref of Invocation.result_reference
137
138let ids lst = Ids lst
139let id x = Ids [x]
140
141let make_ref ~call_id ~method_name ~path =
142 Ref (Invocation.result_reference_of_strings
143 ~result_of:call_id
144 ~name:method_name
145 ~path)
146
147let from_query : type r. (query, r) handle -> id_source = fun h ->
148 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/ids"
149
150let from_get_ids : type r. (get, r) handle -> id_source = fun h ->
151 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/list/*/id"
152
153let from_get_field : type r. (get, r) handle -> string -> id_source = fun h field ->
154 make_ref ~call_id:(call_id h) ~method_name:(method_name h)
155 ~path:(Printf.sprintf "/list/*/%s" field)
156
157let from_changes_created : type r. (changes, r) handle -> id_source = fun h ->
158 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/created"
159
160let from_changes_updated : type r. (changes, r) handle -> id_source = fun h ->
161 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/updated"
162
163let from_changes_destroyed : type r. (changes, r) handle -> id_source = fun h ->
164 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/destroyed"
165
166let from_set_created : type r. (set, r) handle -> id_source = fun h ->
167 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/created/*/id"
168
169let from_set_updated : type r. (set, r) handle -> id_source = fun h ->
170 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/updated"
171
172let from_query_changes_removed : type r. (query_changes, r) handle -> id_source = fun h ->
173 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/removed"
174
175let from_query_changes_added : type r. (query_changes, r) handle -> id_source = fun h ->
176 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/added/*/id"
177
178let from_copy_created : type r. (copy, r) handle -> id_source = fun h ->
179 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/created/*/id"
180
181let from_import_created : type r. (import, r) handle -> id_source = fun h ->
182 make_ref ~call_id:(call_id h) ~method_name:(method_name h) ~path:"/created/*/id"
183
184(* Chain state *)
185type state = {
186 mutable next_id : int;
187 mutable next_create_id : int;
188 mutable invocations : Invocation.t list;
189}
190
191(* Chain monad *)
192type 'a t = state -> 'a
193
194let return x _state = x
195
196let bind m f state =
197 let a = m state in
198 f a state
199
200let map f m state =
201 f (m state)
202
203let both a b state =
204 let x = a state in
205 let y = b state in
206 (x, y)
207
208let ( let* ) = bind
209let ( let+ ) m f = map f m
210let ( and* ) = both
211let ( and+ ) = both
212
213(* Building *)
214let fresh_call_id state =
215 let id = Printf.sprintf "c%d" state.next_id in
216 state.next_id <- state.next_id + 1;
217 id
218
219let fresh_create_id () state =
220 let id = Printf.sprintf "k%d" state.next_create_id in
221 state.next_create_id <- state.next_create_id + 1;
222 id
223
224let record_invocation inv state =
225 state.invocations <- inv :: state.invocations
226
227let build ~capabilities chain =
228 let state = { next_id = 0; next_create_id = 0; invocations = [] } in
229 let result = chain state in
230 let request = Request.create
231 ~using:capabilities
232 ~method_calls:(List.rev state.invocations)
233 ()
234 in
235 (request, result)
236
237let build_request ~capabilities chain =
238 fst (build ~capabilities chain)
239
240(* JSON helpers - exported *)
241let json_null = Jsont.Null ((), Jsont.Meta.none)
242
243let json_bool b = Jsont.Bool (b, Jsont.Meta.none)
244
245let json_string s = Jsont.String (s, Jsont.Meta.none)
246
247let json_int n = Jsont.Number (Int64.to_float n, Jsont.Meta.none)
248
249let json_name s = (s, Jsont.Meta.none)
250
251let json_obj fields =
252 let fields' = List.map (fun (k, v) -> (json_name k, v)) fields in
253 Jsont.Object (fields', Jsont.Meta.none)
254
255let json_array items = Jsont.Array (items, Jsont.Meta.none)
256
257(* JSON helpers - internal *)
258let json_of_id id =
259 Jsont.String (Id.to_string id, Jsont.Meta.none)
260
261let json_of_id_list ids =
262 let items = List.map json_of_id ids in
263 Jsont.Array (items, Jsont.Meta.none)
264
265let json_of_string_list strs =
266 let items = List.map json_string strs in
267 Jsont.Array (items, Jsont.Meta.none)
268
269let json_map pairs =
270 let fields' = List.map (fun (k, v) -> (json_name k, v)) pairs in
271 Jsont.Object (fields', Jsont.Meta.none)
272
273let encode_to_json jsont value =
274 match Jsont.Json.encode' jsont value with
275 | Ok j -> j
276 | Error _ -> json_obj []
277
278let encode_list_to_json jsont values =
279 match Jsont.Json.encode' (Jsont.list jsont) values with
280 | Ok j -> j
281 | Error _ -> Jsont.Array ([], Jsont.Meta.none)
282
283(* Add id_source to args *)
284let add_ids_arg args = function
285 | None -> args
286 | Some (Ids ids) ->
287 ("ids", json_of_id_list ids) :: args
288 | Some (Ref ref_) ->
289 let ref_json = encode_to_json Invocation.result_reference_jsont ref_ in
290 ("#ids", ref_json) :: args
291
292let add_destroy_arg args = function
293 | None -> args
294 | Some (Ids ids) ->
295 ("destroy", json_of_id_list ids) :: args
296 | Some (Ref ref_) ->
297 let ref_json = encode_to_json Invocation.result_reference_jsont ref_ in
298 ("#destroy", ref_json) :: args
299
300(* Query builder helper *)
301let build_query_args ~account_id ?filter ?filter_jsont ?sort ?position ?anchor
302 ?anchor_offset ?limit ?calculate_total () =
303 let args = [ ("accountId", json_of_id account_id) ] in
304 let args = match filter, filter_jsont with
305 | Some f, Some jsont -> ("filter", encode_to_json jsont f) :: args
306 | _ -> args
307 in
308 let args = match sort with
309 | None -> args
310 | Some comparators -> ("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args
311 in
312 let args = match position with
313 | None -> args
314 | Some n -> ("position", json_int n) :: args
315 in
316 let args = match anchor with
317 | None -> args
318 | Some id -> ("anchor", json_of_id id) :: args
319 in
320 let args = match anchor_offset with
321 | None -> args
322 | Some n -> ("anchorOffset", json_int n) :: args
323 in
324 let args = match limit with
325 | None -> args
326 | Some n -> ("limit", json_int n) :: args
327 in
328 let args = match calculate_total with
329 | None -> args
330 | Some b -> ("calculateTotal", json_bool b) :: args
331 in
332 args
333
334(* Changes builder helper *)
335let build_changes_args ~account_id ~since_state ?max_changes () =
336 let args = [
337 ("accountId", json_of_id account_id);
338 ("sinceState", json_string since_state);
339 ] in
340 let args = match max_changes with
341 | None -> args
342 | Some n -> ("maxChanges", json_int n) :: args
343 in
344 args
345
346(* QueryChanges builder helper *)
347let build_query_changes_args ~account_id ~since_query_state ?filter ?filter_jsont
348 ?sort ?max_changes ?up_to_id ?calculate_total () =
349 let args = [
350 ("accountId", json_of_id account_id);
351 ("sinceQueryState", json_string since_query_state);
352 ] in
353 let args = match filter, filter_jsont with
354 | Some f, Some jsont -> ("filter", encode_to_json jsont f) :: args
355 | _ -> args
356 in
357 let args = match sort with
358 | None -> args
359 | Some comparators -> ("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args
360 in
361 let args = match max_changes with
362 | None -> args
363 | Some n -> ("maxChanges", json_int n) :: args
364 in
365 let args = match up_to_id with
366 | None -> args
367 | Some id -> ("upToId", json_of_id id) :: args
368 in
369 let args = match calculate_total with
370 | None -> args
371 | Some b -> ("calculateTotal", json_bool b) :: args
372 in
373 args
374
375(* Set builder helper *)
376let build_set_args ~account_id ?if_in_state ?create ?update ?destroy () =
377 let args = [ ("accountId", json_of_id account_id) ] in
378 let args = match if_in_state with
379 | None -> args
380 | Some s -> ("ifInState", json_string s) :: args
381 in
382 let args = match create with
383 | None | Some [] -> args
384 | Some items ->
385 let create_map = json_map (List.map (fun (cid, obj) -> (cid, obj)) items) in
386 ("create", create_map) :: args
387 in
388 let args = match update with
389 | None | Some [] -> args
390 | Some items ->
391 let update_map = json_map (List.map (fun (id, patch) -> (Id.to_string id, patch)) items) in
392 ("update", update_map) :: args
393 in
394 let args = add_destroy_arg args destroy in
395 args
396
397(* Method builders *)
398
399let email_query ~account_id ?filter ?sort ?position ?anchor ?anchor_offset
400 ?limit ?calculate_total ?collapse_threads () state =
401 let call_id = fresh_call_id state in
402 let args = build_query_args ~account_id ?filter
403 ~filter_jsont:Mail_filter.email_filter_jsont
404 ?sort ?position ?anchor ?anchor_offset ?limit ?calculate_total () in
405 let args = match collapse_threads with
406 | None -> args
407 | Some b -> ("collapseThreads", json_bool b) :: args
408 in
409 let inv = Invocation.create
410 ~name:"Email/query"
411 ~arguments:(json_obj args)
412 ~method_call_id:call_id
413 in
414 record_invocation inv state;
415 Query_handle { call_id; method_name = "Email/query" }
416
417let email_get ~account_id ?ids ?properties ?body_properties
418 ?fetch_text_body_values ?fetch_html_body_values ?fetch_all_body_values
419 ?max_body_value_bytes () state =
420 let call_id = fresh_call_id state in
421 let args = [ ("accountId", json_of_id account_id) ] in
422 let args = add_ids_arg args ids in
423 let args = match properties with
424 | None -> args
425 | Some props -> ("properties", json_of_string_list props) :: args
426 in
427 let args = match body_properties with
428 | None -> args
429 | Some props -> ("bodyProperties", json_of_string_list props) :: args
430 in
431 let args = match fetch_text_body_values with
432 | None -> args
433 | Some b -> ("fetchTextBodyValues", json_bool b) :: args
434 in
435 let args = match fetch_html_body_values with
436 | None -> args
437 | Some b -> ("fetchHTMLBodyValues", json_bool b) :: args
438 in
439 let args = match fetch_all_body_values with
440 | None -> args
441 | Some b -> ("fetchAllBodyValues", json_bool b) :: args
442 in
443 let args = match max_body_value_bytes with
444 | None -> args
445 | Some n -> ("maxBodyValueBytes", json_int n) :: args
446 in
447 let inv = Invocation.create
448 ~name:"Email/get"
449 ~arguments:(json_obj args)
450 ~method_call_id:call_id
451 in
452 record_invocation inv state;
453 Email_get_handle { call_id; method_name = "Email/get" }
454
455let email_changes ~account_id ~since_state ?max_changes () state =
456 let call_id = fresh_call_id state in
457 let args = build_changes_args ~account_id ~since_state ?max_changes () in
458 let inv = Invocation.create
459 ~name:"Email/changes"
460 ~arguments:(json_obj args)
461 ~method_call_id:call_id
462 in
463 record_invocation inv state;
464 Changes_handle { call_id; method_name = "Email/changes" }
465
466let email_query_changes ~account_id ~since_query_state ?filter ?sort
467 ?max_changes ?up_to_id ?calculate_total () state =
468 let call_id = fresh_call_id state in
469 let args = build_query_changes_args ~account_id ~since_query_state
470 ?filter ~filter_jsont:Mail_filter.email_filter_jsont
471 ?sort ?max_changes ?up_to_id ?calculate_total () in
472 let inv = Invocation.create
473 ~name:"Email/queryChanges"
474 ~arguments:(json_obj args)
475 ~method_call_id:call_id
476 in
477 record_invocation inv state;
478 Query_changes_handle { call_id; method_name = "Email/queryChanges" }
479
480let email_set ~account_id ?if_in_state ?create ?update ?destroy () state =
481 let call_id = fresh_call_id state in
482 let args = build_set_args ~account_id ?if_in_state ?create ?update ?destroy () in
483 let inv = Invocation.create
484 ~name:"Email/set"
485 ~arguments:(json_obj args)
486 ~method_call_id:call_id
487 in
488 record_invocation inv state;
489 Email_set_handle { call_id; method_name = "Email/set" }
490
491let email_copy ~from_account_id ~account_id ?if_from_in_state ?if_in_state
492 ?create ?on_success_destroy_original ?destroy_from_if_in_state () state =
493 let call_id = fresh_call_id state in
494 let args = [
495 ("fromAccountId", json_of_id from_account_id);
496 ("accountId", json_of_id account_id);
497 ] in
498 let args = match if_from_in_state with
499 | None -> args
500 | Some s -> ("ifFromInState", json_string s) :: args
501 in
502 let args = match if_in_state with
503 | None -> args
504 | Some s -> ("ifInState", json_string s) :: args
505 in
506 let args = match create with
507 | None | Some [] -> args
508 | Some items ->
509 let create_map = json_map (List.map (fun (id, obj) -> (Id.to_string id, obj)) items) in
510 ("create", create_map) :: args
511 in
512 let args = match on_success_destroy_original with
513 | None -> args
514 | Some b -> ("onSuccessDestroyOriginal", json_bool b) :: args
515 in
516 let args = match destroy_from_if_in_state with
517 | None -> args
518 | Some s -> ("destroyFromIfInState", json_string s) :: args
519 in
520 let inv = Invocation.create
521 ~name:"Email/copy"
522 ~arguments:(json_obj args)
523 ~method_call_id:call_id
524 in
525 record_invocation inv state;
526 Email_copy_handle { call_id; method_name = "Email/copy" }
527
528let thread_get ~account_id ?ids () state =
529 let call_id = fresh_call_id state in
530 let args = [ ("accountId", json_of_id account_id) ] in
531 let args = add_ids_arg args ids in
532 let inv = Invocation.create
533 ~name:"Thread/get"
534 ~arguments:(json_obj args)
535 ~method_call_id:call_id
536 in
537 record_invocation inv state;
538 Thread_get_handle { call_id; method_name = "Thread/get" }
539
540let thread_changes ~account_id ~since_state ?max_changes () state =
541 let call_id = fresh_call_id state in
542 let args = build_changes_args ~account_id ~since_state ?max_changes () in
543 let inv = Invocation.create
544 ~name:"Thread/changes"
545 ~arguments:(json_obj args)
546 ~method_call_id:call_id
547 in
548 record_invocation inv state;
549 Changes_handle { call_id; method_name = "Thread/changes" }
550
551let mailbox_query ~account_id ?filter ?sort ?position ?anchor ?anchor_offset
552 ?limit ?calculate_total () state =
553 let call_id = fresh_call_id state in
554 let args = build_query_args ~account_id ?filter
555 ~filter_jsont:Mail_filter.mailbox_filter_jsont
556 ?sort ?position ?anchor ?anchor_offset ?limit ?calculate_total () in
557 let inv = Invocation.create
558 ~name:"Mailbox/query"
559 ~arguments:(json_obj args)
560 ~method_call_id:call_id
561 in
562 record_invocation inv state;
563 Query_handle { call_id; method_name = "Mailbox/query" }
564
565let mailbox_get ~account_id ?ids ?properties () state =
566 let call_id = fresh_call_id state in
567 let args = [ ("accountId", json_of_id account_id) ] in
568 let args = add_ids_arg args ids in
569 let args = match properties with
570 | None -> args
571 | Some props -> ("properties", json_of_string_list props) :: args
572 in
573 let inv = Invocation.create
574 ~name:"Mailbox/get"
575 ~arguments:(json_obj args)
576 ~method_call_id:call_id
577 in
578 record_invocation inv state;
579 Mailbox_get_handle { call_id; method_name = "Mailbox/get" }
580
581let mailbox_changes ~account_id ~since_state ?max_changes () state =
582 let call_id = fresh_call_id state in
583 let args = build_changes_args ~account_id ~since_state ?max_changes () in
584 let inv = Invocation.create
585 ~name:"Mailbox/changes"
586 ~arguments:(json_obj args)
587 ~method_call_id:call_id
588 in
589 record_invocation inv state;
590 Changes_handle { call_id; method_name = "Mailbox/changes" }
591
592let mailbox_query_changes ~account_id ~since_query_state ?filter ?sort
593 ?max_changes ?up_to_id ?calculate_total () state =
594 let call_id = fresh_call_id state in
595 let args = build_query_changes_args ~account_id ~since_query_state
596 ?filter ~filter_jsont:Mail_filter.mailbox_filter_jsont
597 ?sort ?max_changes ?up_to_id ?calculate_total () in
598 let inv = Invocation.create
599 ~name:"Mailbox/queryChanges"
600 ~arguments:(json_obj args)
601 ~method_call_id:call_id
602 in
603 record_invocation inv state;
604 Query_changes_handle { call_id; method_name = "Mailbox/queryChanges" }
605
606let mailbox_set ~account_id ?if_in_state ?create ?update ?destroy
607 ?on_destroy_remove_emails () state =
608 let call_id = fresh_call_id state in
609 let args = build_set_args ~account_id ?if_in_state ?create ?update ?destroy () in
610 let args = match on_destroy_remove_emails with
611 | None -> args
612 | Some b -> ("onDestroyRemoveEmails", json_bool b) :: args
613 in
614 let inv = Invocation.create
615 ~name:"Mailbox/set"
616 ~arguments:(json_obj args)
617 ~method_call_id:call_id
618 in
619 record_invocation inv state;
620 Mailbox_set_handle { call_id; method_name = "Mailbox/set" }
621
622let identity_get ~account_id ?ids ?properties () state =
623 let call_id = fresh_call_id state in
624 let args = [ ("accountId", json_of_id account_id) ] in
625 let args = add_ids_arg args ids in
626 let args = match properties with
627 | None -> args
628 | Some props -> ("properties", json_of_string_list props) :: args
629 in
630 let inv = Invocation.create
631 ~name:"Identity/get"
632 ~arguments:(json_obj args)
633 ~method_call_id:call_id
634 in
635 record_invocation inv state;
636 Identity_get_handle { call_id; method_name = "Identity/get" }
637
638let identity_changes ~account_id ~since_state ?max_changes () state =
639 let call_id = fresh_call_id state in
640 let args = build_changes_args ~account_id ~since_state ?max_changes () in
641 let inv = Invocation.create
642 ~name:"Identity/changes"
643 ~arguments:(json_obj args)
644 ~method_call_id:call_id
645 in
646 record_invocation inv state;
647 Changes_handle { call_id; method_name = "Identity/changes" }
648
649let identity_set ~account_id ?if_in_state ?create ?update ?destroy () state =
650 let call_id = fresh_call_id state in
651 let args = build_set_args ~account_id ?if_in_state ?create ?update ?destroy () in
652 let inv = Invocation.create
653 ~name:"Identity/set"
654 ~arguments:(json_obj args)
655 ~method_call_id:call_id
656 in
657 record_invocation inv state;
658 Identity_set_handle { call_id; method_name = "Identity/set" }
659
660let email_submission_query ~account_id ?filter ?sort ?position ?anchor
661 ?anchor_offset ?limit ?calculate_total () state =
662 let call_id = fresh_call_id state in
663 let args = build_query_args ~account_id ?filter
664 ~filter_jsont:Mail_filter.submission_filter_jsont
665 ?sort ?position ?anchor ?anchor_offset ?limit ?calculate_total () in
666 let inv = Invocation.create
667 ~name:"EmailSubmission/query"
668 ~arguments:(json_obj args)
669 ~method_call_id:call_id
670 in
671 record_invocation inv state;
672 Query_handle { call_id; method_name = "EmailSubmission/query" }
673
674let email_submission_get ~account_id ?ids ?properties () state =
675 let call_id = fresh_call_id state in
676 let args = [ ("accountId", json_of_id account_id) ] in
677 let args = add_ids_arg args ids in
678 let args = match properties with
679 | None -> args
680 | Some props -> ("properties", json_of_string_list props) :: args
681 in
682 let inv = Invocation.create
683 ~name:"EmailSubmission/get"
684 ~arguments:(json_obj args)
685 ~method_call_id:call_id
686 in
687 record_invocation inv state;
688 Submission_get_handle { call_id; method_name = "EmailSubmission/get" }
689
690let email_submission_changes ~account_id ~since_state ?max_changes () state =
691 let call_id = fresh_call_id state in
692 let args = build_changes_args ~account_id ~since_state ?max_changes () in
693 let inv = Invocation.create
694 ~name:"EmailSubmission/changes"
695 ~arguments:(json_obj args)
696 ~method_call_id:call_id
697 in
698 record_invocation inv state;
699 Changes_handle { call_id; method_name = "EmailSubmission/changes" }
700
701let email_submission_query_changes ~account_id ~since_query_state ?filter ?sort
702 ?max_changes ?up_to_id ?calculate_total () state =
703 let call_id = fresh_call_id state in
704 let args = build_query_changes_args ~account_id ~since_query_state
705 ?filter ~filter_jsont:Mail_filter.submission_filter_jsont
706 ?sort ?max_changes ?up_to_id ?calculate_total () in
707 let inv = Invocation.create
708 ~name:"EmailSubmission/queryChanges"
709 ~arguments:(json_obj args)
710 ~method_call_id:call_id
711 in
712 record_invocation inv state;
713 Query_changes_handle { call_id; method_name = "EmailSubmission/queryChanges" }
714
715let email_submission_set ~account_id ?if_in_state ?create ?update ?destroy
716 ?on_success_update_email ?on_success_destroy_email () state =
717 let call_id = fresh_call_id state in
718 let args = build_set_args ~account_id ?if_in_state ?create ?update ?destroy () in
719 let args = match on_success_update_email with
720 | None | Some [] -> args
721 | Some items ->
722 let update_map = json_map items in
723 ("onSuccessUpdateEmail", update_map) :: args
724 in
725 let args = match on_success_destroy_email with
726 | None | Some [] -> args
727 | Some ids ->
728 ("onSuccessDestroyEmail", json_of_string_list ids) :: args
729 in
730 let inv = Invocation.create
731 ~name:"EmailSubmission/set"
732 ~arguments:(json_obj args)
733 ~method_call_id:call_id
734 in
735 record_invocation inv state;
736 Submission_set_handle { call_id; method_name = "EmailSubmission/set" }
737
738let search_snippet_get ~account_id ~filter ~email_ids () state =
739 let call_id = fresh_call_id state in
740 let args = [ ("accountId", json_of_id account_id) ] in
741 let args = ("filter", encode_to_json Mail_filter.email_filter_jsont filter) :: args in
742 let args = match email_ids with
743 | Ids ids -> ("emailIds", json_of_id_list ids) :: args
744 | Ref ref_ ->
745 let ref_json = encode_to_json Invocation.result_reference_jsont ref_ in
746 ("#emailIds", ref_json) :: args
747 in
748 let inv = Invocation.create
749 ~name:"SearchSnippet/get"
750 ~arguments:(json_obj args)
751 ~method_call_id:call_id
752 in
753 record_invocation inv state;
754 Search_snippet_get_handle { call_id; method_name = "SearchSnippet/get" }
755
756let vacation_response_get ~account_id ?properties () state =
757 let call_id = fresh_call_id state in
758 let args = [ ("accountId", json_of_id account_id) ] in
759 let args = match properties with
760 | None -> args
761 | Some props -> ("properties", json_of_string_list props) :: args
762 in
763 let inv = Invocation.create
764 ~name:"VacationResponse/get"
765 ~arguments:(json_obj args)
766 ~method_call_id:call_id
767 in
768 record_invocation inv state;
769 Vacation_get_handle { call_id; method_name = "VacationResponse/get" }
770
771let vacation_response_set ~account_id ?if_in_state ~update () state =
772 let call_id = fresh_call_id state in
773 let args = [ ("accountId", json_of_id account_id) ] in
774 let args = match if_in_state with
775 | None -> args
776 | Some s -> ("ifInState", json_string s) :: args
777 in
778 let args = ("update", json_map [("singleton", update)]) :: args in
779 let inv = Invocation.create
780 ~name:"VacationResponse/set"
781 ~arguments:(json_obj args)
782 ~method_call_id:call_id
783 in
784 record_invocation inv state;
785 Vacation_set_handle { call_id; method_name = "VacationResponse/set" }
786
787let raw_invocation ~name ~arguments state =
788 let call_id = fresh_call_id state in
789 let inv = Invocation.create
790 ~name
791 ~arguments
792 ~method_call_id:call_id
793 in
794 record_invocation inv state;
795 Raw_handle { call_id; method_name = name }
796
797(* Response parsing *)
798
799let find_invocation ~call_id response =
800 List.find_opt
801 (fun inv -> Invocation.method_call_id inv = call_id)
802 (Response.method_responses response)
803
804let parse : type k r. (k, r) handle -> Response.t -> (r, Jsont.Error.t) result =
805 fun handle response ->
806 let cid = call_id handle in
807 match find_invocation ~call_id:cid response with
808 | None ->
809 Error (Jsont.Error.msgf Jsont.Meta.none "No response found for call_id: %s" cid)
810 | Some inv ->
811 let args = Invocation.arguments inv in
812 match handle with
813 | Query_handle _ ->
814 Jsont.Json.decode' Method.query_response_jsont args
815 | Query_changes_handle _ ->
816 Jsont.Json.decode' Method.query_changes_response_jsont args
817 | Email_get_handle _ ->
818 Jsont.Json.decode' (Method.get_response_jsont Email.jsont) args
819 | Thread_get_handle _ ->
820 Jsont.Json.decode' (Method.get_response_jsont Thread.jsont) args
821 | Mailbox_get_handle _ ->
822 Jsont.Json.decode' (Method.get_response_jsont Mailbox.jsont) args
823 | Identity_get_handle _ ->
824 Jsont.Json.decode' (Method.get_response_jsont Identity.jsont) args
825 | Submission_get_handle _ ->
826 Jsont.Json.decode' (Method.get_response_jsont Submission.jsont) args
827 | Search_snippet_get_handle _ ->
828 Jsont.Json.decode' (Method.get_response_jsont Search_snippet.jsont) args
829 | Vacation_get_handle _ ->
830 Jsont.Json.decode' (Method.get_response_jsont Vacation.jsont) args
831 | Changes_handle _ ->
832 Jsont.Json.decode' Method.changes_response_jsont args
833 | Email_set_handle _ ->
834 Jsont.Json.decode' (Method.set_response_jsont Email.jsont) args
835 | Mailbox_set_handle _ ->
836 Jsont.Json.decode' (Method.set_response_jsont Mailbox.jsont) args
837 | Identity_set_handle _ ->
838 Jsont.Json.decode' (Method.set_response_jsont Identity.jsont) args
839 | Submission_set_handle _ ->
840 Jsont.Json.decode' (Method.set_response_jsont Submission.jsont) args
841 | Vacation_set_handle _ ->
842 Jsont.Json.decode' (Method.set_response_jsont Vacation.jsont) args
843 | Email_copy_handle _ ->
844 Jsont.Json.decode' (Method.copy_response_jsont Email.jsont) args
845 | Raw_handle _ ->
846 Ok args
847
848let parse_exn handle response =
849 match parse handle response with
850 | Ok r -> r
851 | Error e -> failwith (Jsont.Error.to_string e)