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
6module Account = struct
7 type t = {
8 name : string;
9 is_personal : bool;
10 is_read_only : bool;
11 account_capabilities : (string * Jsont.json) list;
12 }
13
14 let name t = t.name
15 let is_personal t = t.is_personal
16 let is_read_only t = t.is_read_only
17 let account_capabilities t = t.account_capabilities
18
19 let make name is_personal is_read_only account_capabilities =
20 { name; is_personal; is_read_only; account_capabilities }
21
22 let jsont =
23 let kind = "Account" in
24 Jsont.Object.map ~kind make
25 |> Jsont.Object.mem "name" Jsont.string ~enc:name
26 |> Jsont.Object.mem "isPersonal" Jsont.bool ~enc:is_personal
27 |> Jsont.Object.mem "isReadOnly" Jsont.bool ~enc:is_read_only
28 |> Jsont.Object.mem "accountCapabilities" (Proto_json_map.of_string Jsont.json) ~enc:account_capabilities
29 |> Jsont.Object.finish
30end
31
32type t = {
33 capabilities : (string * Jsont.json) list;
34 accounts : (Proto_id.t * Account.t) list;
35 primary_accounts : (string * Proto_id.t) list;
36 username : string;
37 api_url : string;
38 download_url : string;
39 upload_url : string;
40 event_source_url : string;
41 state : string;
42}
43
44let capabilities t = t.capabilities
45let accounts t = t.accounts
46let primary_accounts t = t.primary_accounts
47let username t = t.username
48let api_url t = t.api_url
49let download_url t = t.download_url
50let upload_url t = t.upload_url
51let event_source_url t = t.event_source_url
52let state t = t.state
53
54let make capabilities accounts primary_accounts username api_url
55 download_url upload_url event_source_url state =
56 { capabilities; accounts; primary_accounts; username; api_url;
57 download_url; upload_url; event_source_url; state }
58
59let jsont =
60 let kind = "Session" in
61 Jsont.Object.map ~kind make
62 |> Jsont.Object.mem "capabilities" (Proto_json_map.of_string Jsont.json) ~enc:capabilities
63 |> Jsont.Object.mem "accounts" (Proto_json_map.of_id Account.jsont) ~enc:accounts
64 |> Jsont.Object.mem "primaryAccounts" (Proto_json_map.of_string Proto_id.jsont) ~enc:primary_accounts
65 |> Jsont.Object.mem "username" Jsont.string ~enc:username
66 |> Jsont.Object.mem "apiUrl" Jsont.string ~enc:api_url
67 |> Jsont.Object.mem "downloadUrl" Jsont.string ~enc:download_url
68 |> Jsont.Object.mem "uploadUrl" Jsont.string ~enc:upload_url
69 |> Jsont.Object.mem "eventSourceUrl" Jsont.string ~enc:event_source_url
70 |> Jsont.Object.mem "state" Jsont.string ~enc:state
71 |> Jsont.Object.finish
72
73let get_account id session =
74 List.assoc_opt id session.accounts
75
76let primary_account_for capability session =
77 List.assoc_opt capability session.primary_accounts
78
79let has_capability uri session =
80 List.exists (fun (k, _) -> k = uri) session.capabilities
81
82let get_core_capability session =
83 match List.assoc_opt Proto_capability.core session.capabilities with
84 | None -> None
85 | Some json ->
86 (match Jsont.Json.decode' Proto_capability.Core.jsont json with
87 | Ok v -> Some v
88 | Error _ -> None)
89
90let get_mail_capability session =
91 match List.assoc_opt Proto_capability.mail session.capabilities with
92 | None -> None
93 | Some json ->
94 (match Jsont.Json.decode' Proto_capability.Mail.jsont json with
95 | Ok v -> Some v
96 | Error _ -> None)