My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP Session and Account Types
2
3 The Session object describes the server's capabilities and the accounts
4 available to the current user.
5
6 Reference: RFC 8620 Section 2
7 Test files: test/data/core/session.json
8*)
9
10(** Account object *)
11module Account = struct
12 type t = {
13 name : string;
14 is_personal : bool;
15 is_read_only : bool;
16 account_capabilities : (string * Ezjsonm.value) list;
17 }
18
19 (** Accessors *)
20 let name t = t.name
21 let is_personal t = t.is_personal
22 let is_read_only t = t.is_read_only
23 let account_capabilities t = t.account_capabilities
24
25 (** Constructor *)
26 let v ~name ~is_personal ~is_read_only ~account_capabilities =
27 { name; is_personal; is_read_only; account_capabilities }
28
29 (** Parse from JSON.
30 Test files: test/data/core/session.json (accounts field) *)
31 let of_json json =
32 match json with
33 | `O fields ->
34 let get_string name =
35 match List.assoc_opt name fields with
36 | Some (`String s) -> s
37 | Some _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a string" name))
38 | None -> raise (Jmap_error.Parse_error (Printf.sprintf "Missing field: %s" name))
39 in
40 let get_bool name =
41 match List.assoc_opt name fields with
42 | Some (`Bool b) -> b
43 | Some _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a boolean" name))
44 | None -> raise (Jmap_error.Parse_error (Printf.sprintf "Missing field: %s" name))
45 in
46 let name = get_string "name" in
47 let is_personal = get_bool "isPersonal" in
48 let is_read_only = get_bool "isReadOnly" in
49 let account_capabilities =
50 match List.assoc_opt "accountCapabilities" fields with
51 | Some (`O caps) -> caps
52 | Some _ -> raise (Jmap_error.Parse_error "accountCapabilities must be an object")
53 | None -> []
54 in
55 { name; is_personal; is_read_only; account_capabilities }
56 | _ -> raise (Jmap_error.Parse_error "Account must be a JSON object")
57end
58
59(** Session object *)
60type t = {
61 capabilities : (string * Ezjsonm.value) list;
62 accounts : (Jmap_id.t * Account.t) list;
63 primary_accounts : (string * Jmap_id.t) list;
64 username : string;
65 api_url : string;
66 download_url : string;
67 upload_url : string;
68 event_source_url : string;
69 state : string;
70}
71
72(** Accessors *)
73let capabilities t = t.capabilities
74let accounts t = t.accounts
75let primary_accounts t = t.primary_accounts
76let username t = t.username
77let api_url t = t.api_url
78let download_url t = t.download_url
79let upload_url t = t.upload_url
80let event_source_url t = t.event_source_url
81let state t = t.state
82
83(** Constructor *)
84let v ~capabilities ~accounts ~primary_accounts ~username ~api_url ~download_url ~upload_url ~event_source_url ~state =
85 { capabilities; accounts; primary_accounts; username; api_url; download_url; upload_url; event_source_url; state }
86
87(** Parser submodule *)
88module Parser = struct
89 (** Parse session from JSON.
90 Test files: test/data/core/session.json
91
92 Expected structure:
93 {
94 "capabilities": {
95 "urn:ietf:params:jmap:core": {...},
96 "urn:ietf:params:jmap:mail": {...},
97 ...
98 },
99 "accounts": {
100 "account-id": {
101 "name": "user@example.com",
102 "isPersonal": true,
103 "isReadOnly": false,
104 "accountCapabilities": {...}
105 },
106 ...
107 },
108 "primaryAccounts": {
109 "urn:ietf:params:jmap:mail": "account-id",
110 ...
111 },
112 "username": "user@example.com",
113 "apiUrl": "https://jmap.example.com/api/",
114 "downloadUrl": "https://jmap.example.com/download/{accountId}/{blobId}/{name}",
115 "uploadUrl": "https://jmap.example.com/upload/{accountId}/",
116 "eventSourceUrl": "https://jmap.example.com/eventsource/",
117 "state": "cyrus-0"
118 }
119 *)
120 let of_json json =
121 match json with
122 | `O fields ->
123 let get_string name =
124 match List.assoc_opt name fields with
125 | Some (`String s) -> s
126 | Some _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a string" name))
127 | None -> raise (Jmap_error.Parse_error (Printf.sprintf "Missing field: %s" name))
128 in
129 let require_field name =
130 match List.assoc_opt name fields with
131 | Some v -> v
132 | None -> raise (Jmap_error.Parse_error (Printf.sprintf "Missing field: %s" name))
133 in
134
135 (* Parse capabilities *)
136 let capabilities =
137 match require_field "capabilities" with
138 | `O caps -> caps
139 | _ -> raise (Jmap_error.Parse_error "capabilities must be an object")
140 in
141
142 (* Parse accounts *)
143 let accounts =
144 match require_field "accounts" with
145 | `O accts ->
146 List.map (fun (id, acct_json) ->
147 (Jmap_id.of_string id, Account.of_json acct_json)
148 ) accts
149 | _ -> raise (Jmap_error.Parse_error "accounts must be an object")
150 in
151
152 (* Parse primaryAccounts *)
153 let primary_accounts =
154 match require_field "primaryAccounts" with
155 | `O prim ->
156 List.map (fun (cap, id_json) ->
157 match id_json with
158 | `String id -> (cap, Jmap_id.of_string id)
159 | _ -> raise (Jmap_error.Parse_error "primaryAccounts values must be strings")
160 ) prim
161 | _ -> raise (Jmap_error.Parse_error "primaryAccounts must be an object")
162 in
163
164 let username = get_string "username" in
165 let api_url = get_string "apiUrl" in
166 let download_url = get_string "downloadUrl" in
167 let upload_url = get_string "uploadUrl" in
168 let event_source_url = get_string "eventSourceUrl" in
169 let state = get_string "state" in
170
171 { capabilities; accounts; primary_accounts; username; api_url;
172 download_url; upload_url; event_source_url; state }
173 | _ -> raise (Jmap_error.Parse_error "Session must be a JSON object")
174
175 let of_string s =
176 try
177 of_json (Ezjsonm.from_string s)
178 with
179 | Ezjsonm.Parse_error (_, msg) ->
180 raise (Jmap_error.Parse_error ("Invalid JSON: " ^ msg))
181
182 let of_channel ic =
183 try
184 of_json (Ezjsonm.from_channel ic)
185 with
186 | Ezjsonm.Parse_error (_, msg) ->
187 raise (Jmap_error.Parse_error ("Invalid JSON: " ^ msg))
188end