objective categorical abstract machine language personal data server
/account/login and /account/logout
+46
-1
+5
-1
bin/main.ml
+5
-1
bin/main.ml
···
18
18
; (get, "/oauth/authorize", Api.Oauth_.Authorize.get_handler)
19
19
; (post, "/oauth/authorize", Api.Oauth_.Authorize.post_handler)
20
20
; (post, "/oauth/token", Api.Oauth_.Token.handler)
21
+
; (* account *)
22
+
(get, "/account/login", Api.Account_.Login.get_handler)
23
+
; (post, "/account/login", Api.Account_.Login.post_handler)
24
+
; (get, "/account/logout", Api.Account_.Logout.handler)
21
25
; (* unauthed *)
22
26
( get
23
27
, "/xrpc/com.atproto.server.describeServer"
···
26
30
; ( get
27
31
, "/xrpc/com.atproto.identity.resolveHandle"
28
32
, Api.Identity.ResolveHandle.handler )
29
-
; (* account *)
33
+
; (* account management *)
30
34
( post
31
35
, "/xrpc/com.atproto.server.createInviteCode"
32
36
, Api.Server.CreateInviteCode.handler )
+37
pegasus/lib/api/account_/login.ml
+37
pegasus/lib/api/account_/login.ml
···
1
+
let get_handler =
2
+
Xrpc.handler (fun ctx ->
3
+
let _redirect_url =
4
+
Dream.query ctx.req "redirect_url" |> Option.value ~default:"/"
5
+
in
6
+
(* render login page with
7
+
[ ("redirect_url", `String redirect_url)
8
+
; ("error", `Null) ]
9
+
*)
10
+
Dream.html "" )
11
+
12
+
let post_handler =
13
+
Xrpc.handler (fun ctx ->
14
+
let%lwt form = Dream.form ctx.req in
15
+
match form with
16
+
| `Ok fields -> (
17
+
let identifier = List.assoc "identifier" fields in
18
+
let password = List.assoc "password" fields in
19
+
let redirect_url =
20
+
List.assoc_opt "redirect_url" fields |> Option.value ~default:"/"
21
+
in
22
+
let%lwt actor =
23
+
Data_store.try_login ~id:identifier ~password ctx.db
24
+
in
25
+
match actor with
26
+
| None ->
27
+
(* render login page with
28
+
[ ("error", `String "Invalid credentials")
29
+
; ("redirect_url", `String redirect_url) ]
30
+
*)
31
+
Dream.html ~status:`Unauthorized ""
32
+
| Some {did; _} ->
33
+
let%lwt () = Dream.invalidate_session ctx.req in
34
+
let%lwt () = Dream.set_session_field ctx.req "did" did in
35
+
Dream.redirect ctx.req redirect_url )
36
+
| _ ->
37
+
Errors.invalid_request "invalid request body" )