anil.recoil.org
Matrix protocol in OCaml, Eio specialised
1(** Account management operations. *)
2
3(* Account data *)
4let get_account_data client ~event_type =
5 match Client.user_id client with
6 | None -> Error (Error.Network_error "Not logged in")
7 | Some user_id ->
8 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
9 let path = Printf.sprintf "/user/%s/account_data/%s"
10 (Uri.pct_encode user_id_str)
11 (Uri.pct_encode event_type)
12 in
13 match Client.get client ~path () with
14 | Error e -> Error e
15 | Ok body -> Client.decode_response Jsont.json body
16
17let set_account_data client ~event_type ~content =
18 match Client.user_id client with
19 | None -> Error (Error.Network_error "Not logged in")
20 | Some user_id ->
21 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
22 let path = Printf.sprintf "/user/%s/account_data/%s"
23 (Uri.pct_encode user_id_str)
24 (Uri.pct_encode event_type)
25 in
26 match Client.encode_body Jsont.json content with
27 | Error e -> Error e
28 | Ok body ->
29 match Client.put client ~path ~body () with
30 | Error e -> Error e
31 | Ok _ -> Ok ()
32
33let get_room_account_data client ~room_id ~event_type =
34 match Client.user_id client with
35 | None -> Error (Error.Network_error "Not logged in")
36 | Some user_id ->
37 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
38 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
39 let path = Printf.sprintf "/user/%s/rooms/%s/account_data/%s"
40 (Uri.pct_encode user_id_str)
41 (Uri.pct_encode room_id_str)
42 (Uri.pct_encode event_type)
43 in
44 match Client.get client ~path () with
45 | Error e -> Error e
46 | Ok body -> Client.decode_response Jsont.json body
47
48let set_room_account_data client ~room_id ~event_type ~content =
49 match Client.user_id client with
50 | None -> Error (Error.Network_error "Not logged in")
51 | Some user_id ->
52 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
53 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
54 let path = Printf.sprintf "/user/%s/rooms/%s/account_data/%s"
55 (Uri.pct_encode user_id_str)
56 (Uri.pct_encode room_id_str)
57 (Uri.pct_encode event_type)
58 in
59 match Client.encode_body Jsont.json content with
60 | Error e -> Error e
61 | Ok body ->
62 match Client.put client ~path ~body () with
63 | Error e -> Error e
64 | Ok _ -> Ok ()
65
66(* Third-party identifiers *)
67type threepid = {
68 medium : string;
69 address : string;
70 validated_at : int64;
71 added_at : int64;
72}
73
74let threepid_jsont =
75 Jsont.Object.(
76 map (fun medium address validated_at added_at ->
77 { medium; address; validated_at; added_at })
78 |> mem "medium" Jsont.string
79 |> mem "address" Jsont.string
80 |> mem "validated_at" Jsont.int64
81 |> mem "added_at" Jsont.int64
82 |> finish)
83
84type threepids_response = {
85 threepids : threepid list;
86}
87
88let threepids_response_jsont =
89 Jsont.Object.(
90 map (fun threepids -> { threepids })
91 |> mem "threepids" (Jsont.list threepid_jsont) ~dec_absent:[]
92 |> finish)
93
94let get_3pids client =
95 match Client.get client ~path:"/account/3pid" () with
96 | Error e -> Error e
97 | Ok body ->
98 match Client.decode_response threepids_response_jsont body with
99 | Error e -> Error e
100 | Ok resp -> Ok resp.threepids
101
102(* Email token request *)
103type email_token_request = {
104 email : string;
105 client_secret : string;
106 send_attempt : int;
107} [@@warning "-69"]
108
109let email_token_request_jsont =
110 Jsont.Object.(
111 map (fun email client_secret send_attempt ->
112 { email; client_secret; send_attempt })
113 |> mem "email" Jsont.string
114 |> mem "client_secret" Jsont.string
115 |> mem "send_attempt" Jsont.int
116 |> finish)
117
118type token_response = {
119 sid : string;
120}
121
122let token_response_jsont =
123 Jsont.Object.(
124 map (fun sid -> { sid })
125 |> mem "sid" Jsont.string
126 |> finish)
127
128let request_email_token client ~email ~client_secret ~send_attempt =
129 let request = { email; client_secret; send_attempt } in
130 match Client.encode_body email_token_request_jsont request with
131 | Error e -> Error e
132 | Ok body ->
133 match Client.post client ~path:"/account/3pid/email/requestToken" ~body () with
134 | Error e -> Error e
135 | Ok body ->
136 match Client.decode_response token_response_jsont body with
137 | Error e -> Error e
138 | Ok resp -> Ok resp.sid
139
140(* MSISDN token request *)
141type msisdn_token_request = {
142 country : string;
143 phone_number : string;
144 client_secret : string;
145 send_attempt : int;
146} [@@warning "-69"]
147
148let msisdn_token_request_jsont =
149 Jsont.Object.(
150 map (fun country phone_number client_secret send_attempt ->
151 { country; phone_number; client_secret; send_attempt })
152 |> mem "country" Jsont.string
153 |> mem "phone_number" Jsont.string
154 |> mem "client_secret" Jsont.string
155 |> mem "send_attempt" Jsont.int
156 |> finish)
157
158let request_msisdn_token client ~country ~phone_number ~client_secret ~send_attempt =
159 let request = { country; phone_number; client_secret; send_attempt } in
160 match Client.encode_body msisdn_token_request_jsont request with
161 | Error e -> Error e
162 | Ok body ->
163 match Client.post client ~path:"/account/3pid/msisdn/requestToken" ~body () with
164 | Error e -> Error e
165 | Ok body ->
166 match Client.decode_response token_response_jsont body with
167 | Error e -> Error e
168 | Ok resp -> Ok resp.sid
169
170(* Add 3pid *)
171type add_3pid_request = {
172 client_secret : string;
173 sid : string;
174} [@@warning "-69"]
175
176let add_3pid_request_jsont =
177 Jsont.Object.(
178 map (fun client_secret sid -> { client_secret; sid })
179 |> mem "client_secret" Jsont.string
180 |> mem "sid" Jsont.string
181 |> finish)
182
183let add_3pid client ~client_secret ~sid =
184 let request = { client_secret; sid } in
185 match Client.encode_body add_3pid_request_jsont request with
186 | Error e -> Error e
187 | Ok body ->
188 match Client.post client ~path:"/account/3pid/add" ~body () with
189 | Error e -> Error e
190 | Ok _ -> Ok ()
191
192(* Delete 3pid *)
193type delete_3pid_request = {
194 medium : string;
195 address : string;
196} [@@warning "-69"]
197
198let delete_3pid_request_jsont =
199 Jsont.Object.(
200 map (fun medium address -> { medium; address })
201 |> mem "medium" Jsont.string
202 |> mem "address" Jsont.string
203 |> finish)
204
205let delete_3pid client ~medium ~address =
206 let request = { medium; address } in
207 match Client.encode_body delete_3pid_request_jsont request with
208 | Error e -> Error e
209 | Ok body ->
210 match Client.post client ~path:"/account/3pid/delete" ~body () with
211 | Error e -> Error e
212 | Ok _ -> Ok ()
213
214(* Password change - simplified without UIAA *)
215type change_password_request = {
216 new_password : string;
217 logout_devices : bool;
218} [@@warning "-69"]
219
220let change_password_request_jsont =
221 Jsont.Object.(
222 map (fun new_password logout_devices -> { new_password; logout_devices })
223 |> mem "new_password" Jsont.string
224 |> mem "logout_devices" Jsont.bool ~dec_absent:false
225 |> finish)
226
227let change_password client ~new_password ?(logout_devices = false) () =
228 let request = { new_password; logout_devices } in
229 match Client.encode_body change_password_request_jsont request with
230 | Error e -> Error e
231 | Ok body ->
232 match Client.post client ~path:"/account/password" ~body () with
233 | Error e -> Error e
234 | Ok _ -> Ok ()
235
236(* Account deactivation - simplified without UIAA *)
237type deactivate_request = {
238 erase : bool;
239} [@@warning "-69"]
240
241let deactivate_request_jsont =
242 Jsont.Object.(
243 map (fun erase -> { erase })
244 |> mem "erase" Jsont.bool ~dec_absent:false
245 |> finish)
246
247let deactivate client ?(erase = false) () =
248 let request = { erase } in
249 match Client.encode_body deactivate_request_jsont request with
250 | Error e -> Error e
251 | Ok body ->
252 match Client.post client ~path:"/account/deactivate" ~body () with
253 | Error e -> Error e
254 | Ok _ -> Ok ()
255
256(* Ignored users - stored in account data *)
257type ignored_users_content = {
258 ignored_users : (string * Jsont.json) list;
259}
260
261let ignored_users_content_jsont =
262 let module StringMap = Map.Make(String) in
263 let map_jsont =
264 Jsont.Object.as_string_map Jsont.json
265 |> Jsont.map
266 ~dec:(fun m -> StringMap.bindings m)
267 ~enc:(fun l -> List.to_seq l |> StringMap.of_seq)
268 in
269 Jsont.Object.(
270 map (fun ignored_users -> { ignored_users })
271 |> mem "ignored_users" map_jsont ~dec_absent:[]
272 |> finish)
273
274let get_ignored_users client =
275 match get_account_data client ~event_type:"m.ignored_user_list" with
276 | Error (Error.Matrix_error { errcode = Error.M_NOT_FOUND; _ }) -> Ok []
277 | Error e -> Error e
278 | Ok json ->
279 match Jsont_bytesrw.decode_string ignored_users_content_jsont
280 (Result.get_ok (Jsont_bytesrw.encode_string Jsont.json json)) with
281 | Error _ -> Ok []
282 | Ok content ->
283 let user_ids = List.filter_map (fun (uid, _) ->
284 match Matrix_proto.Id.User_id.of_string uid with
285 | Ok id -> Some id
286 | Error _ -> None
287 ) content.ignored_users in
288 Ok user_ids
289
290let ignore_user client ~user_id =
291 match get_ignored_users client with
292 | Error e -> Error e
293 | Ok current ->
294 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
295 if List.exists (fun u -> Matrix_proto.Id.User_id.to_string u = user_id_str) current then
296 Ok () (* Already ignored *)
297 else
298 let new_list = user_id :: current in
299 let ignored_map = List.map (fun u ->
300 (Matrix_proto.Id.User_id.to_string u, Jsont.Json.object' [])
301 ) new_list in
302 let content = { ignored_users = ignored_map } in
303 match Client.encode_body ignored_users_content_jsont content with
304 | Error e -> Error e
305 | Ok body ->
306 match Client.decode_response Jsont.json body with
307 | Error e -> Error e
308 | Ok json ->
309 set_account_data client ~event_type:"m.ignored_user_list" ~content:json
310
311let unignore_user client ~user_id =
312 match get_ignored_users client with
313 | Error e -> Error e
314 | Ok current ->
315 let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
316 let new_list = List.filter (fun u ->
317 Matrix_proto.Id.User_id.to_string u <> user_id_str
318 ) current in
319 let ignored_map = List.map (fun u ->
320 (Matrix_proto.Id.User_id.to_string u, Jsont.Json.object' [])
321 ) new_list in
322 let content = { ignored_users = ignored_map } in
323 match Client.encode_body ignored_users_content_jsont content with
324 | Error e -> Error e
325 | Ok body ->
326 match Client.decode_response Jsont.json body with
327 | Error e -> Error e
328 | Ok json ->
329 set_account_data client ~event_type:"m.ignored_user_list" ~content:json