anil.recoil.org
Matrix protocol in OCaml, Eio specialised
1(** Authentication operations. *)
2
3let src = Logs.Src.create "matrix.auth" ~doc:"Matrix authentication"
4module Log = (val Logs.src_log src : Logs.LOG)
5
6(* Login flow types *)
7type login_flow =
8 | Password
9 | Token
10 | Sso
11 | Unknown of string
12
13let login_flow_of_string = function
14 | "m.login.password" -> Password
15 | "m.login.token" -> Token
16 | "m.login.sso" -> Sso
17 | s -> Unknown s
18
19let login_flow_to_string = function
20 | Password -> "m.login.password"
21 | Token -> "m.login.token"
22 | Sso -> "m.login.sso"
23 | Unknown s -> s
24
25(* JSON codecs for login flows response *)
26let login_flow_jsont =
27 Jsont.of_of_string ~kind:"login_flow"
28 ~enc:login_flow_to_string
29 (fun s -> Ok (login_flow_of_string s))
30
31let login_flow_obj_jsont =
32 Jsont.Object.map
33 ~kind:"login_flow_object"
34 (fun flow_type -> flow_type)
35 |> Jsont.Object.mem "type" login_flow_jsont
36 |> Jsont.Object.finish
37
38let login_flows_response_jsont =
39 Jsont.Object.map
40 ~kind:"login_flows_response"
41 (fun flows -> flows)
42 |> Jsont.Object.mem "flows" (Jsont.list login_flow_obj_jsont)
43 |> Jsont.Object.finish
44
45let get_login_flows client =
46 match Client.get client ~path:"/login" () with
47 | Error e -> Error e
48 | Ok body -> Client.decode_response login_flows_response_jsont body
49
50(* Login parameters *)
51type login_params = {
52 device_id : string option;
53 initial_device_display_name : string option;
54}
55
56let default_login_params = {
57 device_id = None;
58 initial_device_display_name = None;
59}
60
61(* Login request codec - write-only types for JSON encoding *)
62type login_request = {
63 req_type : string;
64 identifier : login_identifier;
65 password : string option;
66 token : string option;
67 device_id : string option;
68 initial_device_display_name : string option;
69} [@@warning "-69"]
70
71and login_identifier = {
72 id_type : string;
73 user : string option;
74} [@@warning "-69"]
75
76let login_identifier_jsont =
77 Jsont.Object.(
78 map ~kind:"login_identifier"
79 (fun id_type user -> { id_type; user })
80 |> mem "type" Jsont.string ~enc:(fun t -> t.id_type)
81 |> opt_mem "user" Jsont.string ~enc:(fun t -> t.user)
82 |> finish)
83
84let login_request_jsont =
85 Jsont.Object.(
86 map ~kind:"login_request"
87 (fun req_type identifier password token device_id initial_device_display_name ->
88 { req_type; identifier; password; token; device_id; initial_device_display_name })
89 |> mem "type" Jsont.string ~enc:(fun t -> t.req_type)
90 |> mem "identifier" login_identifier_jsont ~enc:(fun t -> t.identifier)
91 |> opt_mem "password" Jsont.string ~enc:(fun t -> t.password)
92 |> opt_mem "token" Jsont.string ~enc:(fun t -> t.token)
93 |> opt_mem "device_id" Jsont.string ~enc:(fun t -> t.device_id)
94 |> opt_mem "initial_device_display_name" Jsont.string
95 ~enc:(fun t -> t.initial_device_display_name)
96 |> finish)
97
98(* Login response codec *)
99type login_response = {
100 user_id : Matrix_proto.Id.User_id.t;
101 access_token : string;
102 device_id : Matrix_proto.Id.Device_id.t;
103 refresh_token : string option;
104}
105
106let login_response_jsont =
107 Jsont.Object.map
108 ~kind:"login_response"
109 (fun user_id access_token device_id refresh_token ->
110 { user_id; access_token; device_id; refresh_token })
111 |> Jsont.Object.mem "user_id" Matrix_proto.Id.User_id.jsont
112 |> Jsont.Object.mem "access_token" Jsont.string
113 |> Jsont.Object.mem "device_id" Matrix_proto.Id.Device_id.jsont
114 |> Jsont.Object.opt_mem "refresh_token" Jsont.string
115 |> Jsont.Object.finish
116
117let response_to_session resp : Client.session =
118 { user_id = resp.user_id;
119 access_token = resp.access_token;
120 device_id = resp.device_id;
121 refresh_token = resp.refresh_token;
122 }
123
124let login_password client ~user ~password ?(params = default_login_params) () =
125 Log.info (fun m -> m "Logging in as %s" user);
126 let request = {
127 req_type = "m.login.password";
128 identifier = { id_type = "m.id.user"; user = Some user };
129 password = Some password;
130 token = None;
131 device_id = params.device_id;
132 initial_device_display_name = params.initial_device_display_name;
133 } in
134 match Client.encode_body login_request_jsont request with
135 | Error e -> Error e
136 | Ok body ->
137 match Client.post_unauthenticated client ~path:"/login" ~body () with
138 | Error e ->
139 Log.err (fun m -> m "Login failed for user %s" user);
140 Error e
141 | Ok body ->
142 match Client.decode_response login_response_jsont body with
143 | Error e -> Error e
144 | Ok resp ->
145 Log.info (fun m -> m "Login successful: user_id=%s device_id=%s"
146 (Matrix_proto.Id.User_id.to_string resp.user_id)
147 (Matrix_proto.Id.Device_id.to_string resp.device_id));
148 Ok (response_to_session resp)
149
150let login_token client ~token ?(params = default_login_params) () =
151 let request = {
152 req_type = "m.login.token";
153 identifier = { id_type = "m.id.user"; user = None };
154 password = None;
155 token = Some token;
156 device_id = params.device_id;
157 initial_device_display_name = params.initial_device_display_name;
158 } in
159 match Client.encode_body login_request_jsont request with
160 | Error e -> Error e
161 | Ok body ->
162 match Client.post_unauthenticated client ~path:"/login" ~body () with
163 | Error e -> Error e
164 | Ok body ->
165 match Client.decode_response login_response_jsont body with
166 | Error e -> Error e
167 | Ok resp -> Ok (response_to_session resp)
168
169(* Token refresh *)
170type refresh_request = {
171 refresh_token : string;
172} [@@warning "-69"]
173
174let refresh_request_jsont =
175 Jsont.Object.(
176 map ~kind:"refresh_request"
177 (fun refresh_token -> { refresh_token })
178 |> mem "refresh_token" Jsont.string ~enc:(fun t -> t.refresh_token)
179 |> finish)
180
181type refresh_response = {
182 access_token : string;
183 refresh_token : string option;
184}
185
186let refresh_response_jsont =
187 Jsont.Object.map
188 ~kind:"refresh_response"
189 (fun access_token refresh_token -> { access_token; refresh_token })
190 |> Jsont.Object.mem "access_token" Jsont.string
191 |> Jsont.Object.opt_mem "refresh_token" Jsont.string
192 |> Jsont.Object.finish
193
194let refresh_token client ~refresh_token =
195 let request = { refresh_token } in
196 match Client.encode_body refresh_request_jsont request with
197 | Error e -> Error e
198 | Ok body ->
199 match Client.post_unauthenticated client ~path:"/refresh" ~body () with
200 | Error e -> Error e
201 | Ok body ->
202 match Client.decode_response refresh_response_jsont body with
203 | Error e -> Error e
204 | Ok resp -> Ok (resp.access_token, resp.refresh_token)
205
206(* Logout *)
207let logout client =
208 match Client.post client ~path:"/logout" ~body:"{}" () with
209 | Error e -> Error e
210 | Ok _ -> Ok ()
211
212let logout_all client =
213 match Client.post client ~path:"/logout/all" ~body:"{}" () with
214 | Error e -> Error e
215 | Ok _ -> Ok ()
216
217(* Registration *)
218type registration_kind =
219 | User
220 | Guest
221
222type register_request = {
223 kind : string option;
224 username : string option;
225 password : string option;
226 device_id : string option;
227 initial_device_display_name : string option;
228 inhibit_login : bool option;
229} [@@warning "-69"]
230
231let register_request_jsont =
232 Jsont.Object.(
233 map ~kind:"register_request"
234 (fun username password device_id initial_device_display_name inhibit_login ->
235 { kind = None; username; password; device_id; initial_device_display_name; inhibit_login })
236 |> opt_mem "username" Jsont.string ~enc:(fun t -> t.username)
237 |> opt_mem "password" Jsont.string ~enc:(fun t -> t.password)
238 |> opt_mem "device_id" Jsont.string ~enc:(fun t -> t.device_id)
239 |> opt_mem "initial_device_display_name" Jsont.string
240 ~enc:(fun t -> t.initial_device_display_name)
241 |> opt_mem "inhibit_login" Jsont.bool ~enc:(fun t -> t.inhibit_login)
242 |> finish)
243
244type register_response = {
245 user_id : Matrix_proto.Id.User_id.t;
246 access_token : string option;
247 device_id : string option;
248 refresh_token : string option;
249}
250
251let register_response_jsont =
252 Jsont.Object.map
253 ~kind:"register_response"
254 (fun user_id access_token device_id refresh_token ->
255 { user_id; access_token; device_id; refresh_token })
256 |> Jsont.Object.mem "user_id" Matrix_proto.Id.User_id.jsont
257 |> Jsont.Object.opt_mem "access_token" Jsont.string
258 |> Jsont.Object.opt_mem "device_id" Jsont.string
259 |> Jsont.Object.opt_mem "refresh_token" Jsont.string
260 |> Jsont.Object.finish
261
262let register client ?kind ?username ?password ?device_id ?initial_device_display_name ?inhibit_login () =
263 let kind_str = match kind with
264 | Some Guest -> Some "guest"
265 | Some User | None -> None
266 in
267 let query = match kind_str with
268 | Some k -> Some [("kind", k)]
269 | None -> None
270 in
271 let request = {
272 kind = None;
273 username;
274 password;
275 device_id;
276 initial_device_display_name;
277 inhibit_login;
278 } in
279 match Client.encode_body register_request_jsont request with
280 | Error e -> Error e
281 | Ok body ->
282 match Client.post_unauthenticated client ~path:"/register" ?query ~body () with
283 | Error e -> Error e
284 | Ok body ->
285 match Client.decode_response register_response_jsont body with
286 | Error e -> Error e
287 | Ok resp ->
288 match resp.access_token, resp.device_id with
289 | Some access_token, Some device_id ->
290 let device_id = Matrix_proto.Id.Device_id.of_string_exn device_id in
291 Ok { Client.user_id = resp.user_id;
292 access_token;
293 device_id;
294 refresh_token = resp.refresh_token }
295 | _ ->
296 Error (Error.Json_error "Registration succeeded but no session returned (inhibit_login may be true)")
297
298(* Whoami *)
299type whoami_response = {
300 user_id : Matrix_proto.Id.User_id.t;
301}
302
303let whoami_response_jsont =
304 Jsont.Object.map
305 ~kind:"whoami_response"
306 (fun user_id -> { user_id })
307 |> Jsont.Object.mem "user_id" Matrix_proto.Id.User_id.jsont
308 |> Jsont.Object.finish
309
310let whoami client =
311 match Client.get client ~path:"/account/whoami" () with
312 | Error e -> Error e
313 | Ok body ->
314 match Client.decode_response whoami_response_jsont body with
315 | Error e -> Error e
316 | Ok resp -> Ok resp.user_id