objective categorical abstract machine language personal data server
Implement email/password management xrpc endpoints
+157
+12
bin/main.ml
+12
bin/main.ml
···
57
57
; ( post
58
58
, "/xrpc/com.atproto.server.activateAccount"
59
59
, Api.Server.ActivateAccount.handler )
60
+
; ( post
61
+
, "/xrpc/com.atproto.server.requestEmailConfirmation"
62
+
, Api.Server.RequestEmailConfirmation.handler )
63
+
; ( post
64
+
, "/xrpc/com.atproto.server.requestEmailUpdate"
65
+
, Api.Server.RequestEmailUpdate.handler )
66
+
; ( post
67
+
, "/xrpc/com.atproto.server.requestPasswordReset"
68
+
, Api.Server.RequestPasswordReset.handler )
69
+
; ( post
70
+
, "/xrpc/com.atproto.server.resetPassword"
71
+
, Api.Server.ResetPassword.handler )
60
72
; ( get
61
73
, "/xrpc/com.atproto.repo.listMissingBlobs"
62
74
, Api.Repo.ListMissingBlobs.handler )
+26
pegasus/lib/api/server/requestEmailConfirmation.ml
+26
pegasus/lib/api/server/requestEmailConfirmation.ml
···
1
+
let handler =
2
+
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
3
+
Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email
4
+
~action:Oauth.Scopes.Manage ;
5
+
let did = Auth.get_authed_did_exn auth in
6
+
match%lwt Data_store.get_actor_by_identifier did db with
7
+
| None ->
8
+
Errors.internal_error ~msg:"actor not found" ()
9
+
| Some actor -> (
10
+
match actor.email_confirmed_at with
11
+
| Some _ ->
12
+
Errors.invalid_request ~name:"InvalidRequest"
13
+
"email already confirmed"
14
+
| None ->
15
+
let code =
16
+
"eml-"
17
+
^ String.sub
18
+
Digestif.SHA256.(
19
+
digest_string (did ^ Int.to_string @@ Util.now_ms ())
20
+
|> to_hex )
21
+
0 8
22
+
in
23
+
let expires_at = Util.now_ms () + (10 * 60 * 1000) in
24
+
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
25
+
Dream.log "email confirmation code for %s: %s" did code ;
26
+
Dream.empty `OK ) )
+31
pegasus/lib/api/server/requestEmailUpdate.ml
+31
pegasus/lib/api/server/requestEmailUpdate.ml
···
1
+
type response = {token_required: bool [@key "tokenRequired"]}
2
+
[@@deriving yojson]
3
+
4
+
let handler =
5
+
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
6
+
Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email
7
+
~action:Oauth.Scopes.Manage ;
8
+
let did = Auth.get_authed_did_exn auth in
9
+
match%lwt Data_store.get_actor_by_identifier did db with
10
+
| None ->
11
+
Errors.internal_error ~msg:"actor not found" ()
12
+
| Some actor ->
13
+
let token_required = Option.is_some actor.email_confirmed_at in
14
+
let%lwt () =
15
+
if token_required then (
16
+
let code =
17
+
"eml-"
18
+
^ String.sub
19
+
Digestif.SHA256.(
20
+
digest_string (did ^ Int.to_string @@ Util.now_ms ())
21
+
|> to_hex )
22
+
0 8
23
+
in
24
+
let expires_at = Util.now_ms () + (10 * 60 * 1000) in
25
+
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
26
+
Dream.log "email update code for %s: %s" did code ;
27
+
Lwt.return_unit )
28
+
else Lwt.return_unit
29
+
in
30
+
Dream.json @@ Yojson.Safe.to_string
31
+
@@ response_to_yojson {token_required} )
+41
pegasus/lib/api/server/requestPasswordReset.ml
+41
pegasus/lib/api/server/requestPasswordReset.ml
···
1
+
type request = {email: string} [@@deriving yojson {strict= false}]
2
+
3
+
let handler =
4
+
Xrpc.handler (fun {req; auth; db; _} ->
5
+
let%lwt actor_opt =
6
+
match auth with
7
+
| Auth.Access {did} | Auth.OAuth {did; _} -> (
8
+
match%lwt Data_store.get_actor_by_identifier did db with
9
+
| Some actor ->
10
+
Lwt.return_some actor
11
+
| None ->
12
+
Errors.internal_error ~msg:"actor not found" () )
13
+
| _ -> (
14
+
let%lwt {email} = Xrpc.parse_body req request_of_yojson in
15
+
let email = String.lowercase_ascii email in
16
+
match%lwt Data_store.get_actor_by_identifier email db with
17
+
| Some actor ->
18
+
Lwt.return_some actor
19
+
| None ->
20
+
Dream.log "password reset requested for unknown email: %s" email ;
21
+
Lwt.return_none )
22
+
in
23
+
match actor_opt with
24
+
| None ->
25
+
(* always return success to prevent email enumeration *)
26
+
Dream.empty `OK
27
+
| Some actor ->
28
+
let code =
29
+
"pwd-"
30
+
^ String.sub
31
+
Digestif.SHA256.(
32
+
digest_string (actor.did ^ Int.to_string @@ Util.now_ms ())
33
+
|> to_hex )
34
+
0 8
35
+
in
36
+
let expires_at = Util.now_ms () + (10 * 60 * 1000) in
37
+
let%lwt () =
38
+
Data_store.set_auth_code ~did:actor.did ~code ~expires_at db
39
+
in
40
+
Dream.log "password reset code for %s: %s" actor.did code ;
41
+
Dream.empty `OK )
+23
pegasus/lib/api/server/resetPassword.ml
+23
pegasus/lib/api/server/resetPassword.ml
···
1
+
type request = {token: string; password: string}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
let handler =
5
+
Xrpc.handler (fun {req; db; _} ->
6
+
let%lwt {token; password} = Xrpc.parse_body req request_of_yojson in
7
+
match%lwt Data_store.get_actor_by_auth_code ~code:token db with
8
+
| None ->
9
+
Errors.invalid_request ~name:"InvalidToken" "invalid or expired token"
10
+
| Some actor -> (
11
+
match (actor.auth_code, actor.auth_code_expires_at) with
12
+
| Some auth_code, Some auth_expires_at
13
+
when String.starts_with ~prefix:"pwd-" auth_code
14
+
&& token = auth_code
15
+
&& Util.now_ms () < auth_expires_at ->
16
+
let%lwt () =
17
+
Data_store.update_password ~did:actor.did ~password db
18
+
in
19
+
Dream.log "password reset completed for %s" actor.did ;
20
+
Dream.empty `OK
21
+
| _ ->
22
+
Errors.invalid_request ~name:"ExpiredToken"
23
+
"token expired or invalid" ) )
+24
pegasus/lib/data_store.ml
+24
pegasus/lib/data_store.ml
···
123
123
WHERE did = %string{did}
124
124
|sql}]
125
125
126
+
let get_actor_by_auth_code code =
127
+
[%rapper
128
+
get_opt
129
+
{sql| SELECT @int{id}, @string{did}, @string{handle}, @string{email}, @int?{email_confirmed_at}, @string{password_hash}, @string{signing_key}, @Json{preferences}, @int{created_at}, @int?{deactivated_at}, @string?{auth_code}, @int?{auth_code_expires_at}
130
+
FROM actors WHERE auth_code = %string{code}
131
+
LIMIT 1
132
+
|sql}
133
+
record_out]
134
+
code
135
+
136
+
let update_password =
137
+
[%rapper
138
+
execute
139
+
{sql| UPDATE actors SET password_hash = %string{password_hash}, auth_code = NULL, auth_code_expires_at = NULL
140
+
WHERE did = %string{did}
141
+
|sql}]
142
+
126
143
(* firehose *)
127
144
let firehose_insert =
128
145
[%rapper
···
236
253
237
254
let clear_auth_code ~did conn =
238
255
Util.use_pool conn @@ Queries.clear_auth_code ~did
256
+
257
+
let get_actor_by_auth_code ~code conn =
258
+
Util.use_pool conn @@ Queries.get_actor_by_auth_code ~code
259
+
260
+
let update_password ~did ~password conn =
261
+
let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in
262
+
Util.use_pool conn @@ Queries.update_password ~did ~password_hash
239
263
240
264
(* firehose helpers *)
241
265
let append_firehose_event conn ~time ~t ~data : int Lwt.t =