this repo has no description
at main 96 lines 3.4 kB view raw
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)