objective categorical abstract machine language personal data server
Factor out shared logic between dashboard backend and xrpc endpoints
+297
-296
+32
-96
pegasus/lib/api/account_/index.ml
+32
-96
pegasus/lib/api/account_/index.ml
···
5
5
| _ ->
6
6
false
7
7
8
-
let parse_email_change_code code =
9
-
if String.starts_with ~prefix:"eml-" code then
10
-
let rest =
11
-
String.sub code 4 (String.length code - 4)
12
-
|> Base64.decode_exn ~alphabet:Base64.uri_safe_alphabet ~pad:false
13
-
in
14
-
match String.split_on_char ':' rest with
15
-
| [token; new_email] ->
16
-
Some (token, new_email)
17
-
| _ ->
18
-
None
19
-
else None
20
-
21
-
let validate_actor_email_code (actor : Data_store.Types.actor) =
22
-
match (actor.auth_code, actor.auth_code_expires_at) with
23
-
| Some code, Some expires_at when expires_at > Util.now_ms () ->
24
-
parse_email_change_code code
8
+
let has_valid_email_change_code (actor : Data_store.Types.actor) =
9
+
match (actor.auth_code, actor.auth_code_expires_at, actor.pending_email) with
10
+
| Some code, Some expires_at, Some _ ->
11
+
String.starts_with ~prefix:"eml-" code && expires_at > Util.now_ms ()
25
12
| _ ->
26
-
None
13
+
false
27
14
28
15
let get_handler =
29
16
Xrpc.handler (fun ctx ->
···
43
30
in
44
31
let csrf_token = Dream.csrf_token ctx.req in
45
32
let deactivated = actor.deactivated_at <> None in
46
-
let email_change_info = validate_actor_email_code actor in
47
-
let email_change_pending = Option.is_some email_change_info in
48
-
let pending_email = Option.map snd email_change_info in
33
+
let email_change_pending = has_valid_email_change_code actor in
34
+
let pending_email = actor.pending_email in
49
35
let delete_pending = has_valid_delete_code actor in
50
36
Util.render_html ~title:"Account"
51
37
(module Frontend.AccountPage)
···
87
73
in
88
74
let actor = Option.get actor_opt in
89
75
let deactivated = actor.deactivated_at <> None in
90
-
let email_change_info = validate_actor_email_code actor in
91
-
let email_change_pending = Option.is_some email_change_info in
92
-
let pending_email = Option.map snd email_change_info in
76
+
let email_change_pending = has_valid_email_change_code actor in
77
+
let pending_email = actor.pending_email in
93
78
let delete_pending = has_valid_delete_code actor in
94
79
Util.render_html ~title:"Account"
95
80
(module Frontend.AccountPage)
···
121
106
(* update handle if changed *)
122
107
let%lwt handle_result =
123
108
if new_handle <> actor.handle then
124
-
match Util.validate_handle new_handle with
125
-
| Error e ->
126
-
Lwt.return_error e
127
-
| Ok () -> (
128
-
match%lwt
129
-
Data_store.get_actor_by_identifier new_handle
130
-
ctx.db
131
-
with
132
-
| Some _ ->
133
-
Lwt.return_error "Handle already in use"
134
-
| None ->
135
-
let%lwt () =
136
-
Data_store.update_actor_handle ~did
137
-
~handle:new_handle ctx.db
138
-
in
139
-
Lwt.return_ok () )
109
+
Identity.UpdateHandle.update_handle ~did
110
+
~handle:new_handle ctx.db
140
111
else Lwt.return_ok ()
141
112
in
142
113
match handle_result with
···
162
133
render_page ~success:"Your account has been reactivated."
163
134
()
164
135
| Some "deactivate" ->
165
-
let%lwt () = Data_store.deactivate_actor did ctx.db in
166
136
let%lwt _ =
167
-
Sequencer.sequence_account ctx.db ~did ~active:false
168
-
~status:`Deactivated ()
137
+
Server.DeactivateAccount.deactivate_account ~did ctx.db
169
138
in
170
139
let%lwt () = Session.Raw.clear_session ctx.req in
171
140
Dream.redirect ctx.req "/account/login"
172
141
| Some "request_delete" ->
173
-
let code = "del-" ^ Mist.Tid.now () in
174
-
let expires_at = Util.now_ms () + (15 * 60 * 1000) in
175
142
let%lwt () =
176
-
Data_store.set_auth_code ~did ~code ~expires_at ctx.db
177
-
in
178
-
let%lwt () =
179
-
Util.send_email_or_log ~recipients:[To actor.email]
180
-
~subject:"Account deletion confirmation"
181
-
~body:
182
-
(Plain
183
-
(Printf.sprintf
184
-
"Confirm that you would like to delete the \
185
-
account %s (%s) by entering the following \
186
-
code: %s"
187
-
actor.handle did code ) )
143
+
Server.RequestAccountDelete.request_account_delete actor
144
+
ctx.db
188
145
in
189
146
render_page ()
190
147
| Some "confirm_delete" -> (
···
194
151
in
195
152
match (actor.auth_code, actor.auth_code_expires_at) with
196
153
| Some code, Some expires_at
197
-
when code = token && expires_at > Util.now_ms () ->
198
-
let%lwt () = Data_store.delete_actor did ctx.db in
154
+
when String.starts_with ~prefix:"del-" code
155
+
&& code = token
156
+
&& expires_at > Util.now_ms () ->
199
157
let%lwt _ =
200
-
Sequencer.sequence_account ctx.db ~did ~active:false
201
-
~status:`Deleted ()
158
+
Server.DeleteAccount.delete_account ~did ctx.db
202
159
in
203
160
let%lwt () = Session.Raw.clear_session ctx.req in
204
161
Dream.redirect ctx.req "/account/login"
···
229
186
render_page ~email_error:"Email is already in use."
230
187
()
231
188
| None ->
232
-
let token = Mist.Tid.now () in
233
-
let code = token ^ ":" ^ new_email in
234
-
let code =
235
-
Base64.encode_exn
236
-
~alphabet:Base64.uri_safe_alphabet ~pad:false
237
-
code
238
-
in
239
-
let code = "eml-" ^ code in
240
-
let expires_at =
241
-
Util.now_ms () + (15 * 60 * 1000)
242
-
in
243
-
let%lwt () =
244
-
Data_store.set_auth_code ~did ~code ~expires_at
245
-
ctx.db
246
-
in
247
-
let%lwt () =
248
-
Util.send_email_or_log
249
-
~recipients:[To actor.email]
250
-
~subject:"Email change confirmation"
251
-
~body:
252
-
(Plain
253
-
(Printf.sprintf
254
-
"Confirm that you would like to update \
255
-
the email address for @%s (%s) from \
256
-
%s to %s by entering the following \
257
-
code: %s"
258
-
actor.handle did actor.email new_email
259
-
code ) )
189
+
let%lwt _token_required =
190
+
Server.RequestEmailUpdate.request_email_update
191
+
~pending_email:new_email actor ctx.db
260
192
in
261
193
render_page () )
262
194
| Some "confirm_email_change" -> (
···
264
196
List.assoc_opt "token" fields
265
197
|> Option.value ~default:"" |> String.trim
266
198
in
267
-
match validate_actor_email_code actor with
268
-
| Some (_, new_email) when Some token = actor.auth_code ->
269
-
let%lwt () =
270
-
Data_store.update_email ~did ~email:new_email ctx.db
271
-
in
272
-
let%lwt () = Data_store.clear_auth_code ~did ctx.db in
199
+
match%lwt
200
+
Server.UpdateEmail.update_email ~token:(Some token)
201
+
actor ctx.db
202
+
with
203
+
| Ok _ ->
273
204
render_page ~success:"Email address updated." ()
274
-
| _ ->
205
+
| Error Server.UpdateEmail.ExpiredToken
206
+
| Error Server.UpdateEmail.InvalidToken
207
+
| Error Server.UpdateEmail.NoEmailProvided ->
275
208
render_page
276
209
~email_error:"Invalid or expired verification code."
210
+
()
211
+
| Error Server.UpdateEmail.TokenRequired ->
212
+
render_page ~email_error:"Verification code required."
277
213
() )
278
214
| Some "cancel_email_change" ->
279
215
let%lwt () = Data_store.clear_auth_code ~did ctx.db in
+59
-50
pegasus/lib/api/identity/updateHandle.ml
+59
-50
pegasus/lib/api/identity/updateHandle.ml
···
1
1
type request = {handle: string} [@@deriving yojson]
2
2
3
+
let update_handle ~did ~handle db =
4
+
match Util.validate_handle handle with
5
+
| Error e ->
6
+
Lwt.return_error e
7
+
| Ok () -> (
8
+
match%lwt Data_store.get_actor_by_identifier handle db with
9
+
| Some _ ->
10
+
Lwt.return_error "handle already in use"
11
+
| None ->
12
+
let%lwt () = Data_store.update_actor_handle ~did ~handle db in
13
+
let%lwt plc_result =
14
+
if String.starts_with ~prefix:"did:plc:" did then
15
+
match%lwt Plc.get_audit_log did with
16
+
| Error e ->
17
+
Lwt.return_error ("failed to fetch did doc: " ^ e)
18
+
| Ok log -> (
19
+
let latest = List.rev log |> List.hd in
20
+
let aka =
21
+
match
22
+
List.mem ("at://" ^ handle) latest.operation.also_known_as
23
+
with
24
+
| true ->
25
+
latest.operation.also_known_as
26
+
| false ->
27
+
("at://" ^ handle) :: latest.operation.also_known_as
28
+
in
29
+
let signed =
30
+
Plc.sign_operation Env.rotation_key
31
+
(Operation
32
+
{ type'= "plc_operation"
33
+
; prev= Some latest.cid
34
+
; also_known_as= aka
35
+
; rotation_keys= latest.operation.rotation_keys
36
+
; verification_methods=
37
+
latest.operation.verification_methods
38
+
; services= latest.operation.services } )
39
+
in
40
+
match%lwt Plc.submit_operation did signed with
41
+
| Ok _ ->
42
+
Lwt.return_ok ()
43
+
| Error (status, msg) ->
44
+
Lwt.return_error
45
+
(Printf.sprintf "failed to submit plc operation: %d %s"
46
+
status msg ) )
47
+
else Lwt.return_ok ()
48
+
in
49
+
match plc_result with
50
+
| Error e ->
51
+
Lwt.return_error e
52
+
| Ok () ->
53
+
let () = Ttl_cache.String_cache.remove Id_resolver.Did.cache did in
54
+
let%lwt _ = Sequencer.sequence_identity db ~did ~handle () in
55
+
Lwt.return_ok () )
56
+
3
57
let handler =
4
58
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
5
59
Auth.assert_identity_scope auth ~attr:Oauth.Scopes.Handle ;
6
60
let did = Auth.get_authed_did_exn auth in
7
61
let%lwt {handle} = Xrpc.parse_body req request_of_yojson in
8
-
match Util.validate_handle handle with
62
+
match%lwt update_handle ~did ~handle db with
63
+
| Ok () ->
64
+
Dream.empty `OK
9
65
| Error e ->
10
-
Errors.invalid_request ~name:"InvalidHandle" e
11
-
| Ok () -> (
12
-
match%lwt Data_store.get_actor_by_identifier handle db with
13
-
| Some _ ->
14
-
Errors.invalid_request ~name:"InvalidHandle" "handle already in use"
15
-
| None ->
16
-
let%lwt () = Data_store.update_actor_handle ~did ~handle db in
17
-
let%lwt _ =
18
-
if String.starts_with ~prefix:"did:plc:" did then
19
-
match%lwt Plc.get_audit_log did with
20
-
| Error e ->
21
-
Dream.error (fun log -> log ~request:req "%s" e) ;
22
-
Errors.internal_error ~msg:"failed to fetch did doc" ()
23
-
| Ok log -> (
24
-
let latest = List.rev log |> List.hd in
25
-
let aka =
26
-
match
27
-
List.mem ("at://" ^ handle)
28
-
latest.operation.also_known_as
29
-
with
30
-
| true ->
31
-
latest.operation.also_known_as
32
-
| false ->
33
-
("at://" ^ handle) :: latest.operation.also_known_as
34
-
in
35
-
let signed =
36
-
Plc.sign_operation Env.rotation_key
37
-
(Operation
38
-
{ type'= "plc_operation"
39
-
; prev= Some latest.cid
40
-
; also_known_as= aka
41
-
; rotation_keys= latest.operation.rotation_keys
42
-
; verification_methods=
43
-
latest.operation.verification_methods
44
-
; services= latest.operation.services } )
45
-
in
46
-
match%lwt Plc.submit_operation did signed with
47
-
| Ok _ ->
48
-
Lwt.return_unit
49
-
| Error (status, msg) ->
50
-
Dream.error (fun log ->
51
-
log ~request:req "%d %s" status msg ) ;
52
-
Errors.internal_error
53
-
~msg:"failed to submit plc operation" () )
54
-
else Lwt.return_unit
55
-
in
56
-
let () = Ttl_cache.String_cache.remove Id_resolver.Did.cache did in
57
-
let%lwt _ = Sequencer.sequence_identity db ~did ~handle () in
58
-
Dream.empty `OK ) )
66
+
Dream.error (fun log -> log ~request:req "%s" e) ;
67
+
Errors.invalid_request ~name:"InvalidHandle" e )
+5
-4
pegasus/lib/api/server/deactivateAccount.ml
+5
-4
pegasus/lib/api/server/deactivateAccount.ml
···
1
1
type request = {delete_after: string option [@key "deleteAfter"] [@default None]}
2
2
[@@deriving yojson {strict= false}]
3
3
4
+
let deactivate_account ~did db =
5
+
let%lwt () = Data_store.deactivate_actor did db in
6
+
Sequencer.sequence_account db ~did ~active:false ~status:`Deactivated ()
7
+
4
8
let handler =
5
9
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
6
10
let did = Auth.get_authed_did_exn auth in
7
11
(* TODO: handle delete_after *)
8
12
let%lwt _req = Xrpc.parse_body req request_of_yojson in
9
-
let%lwt () = Data_store.deactivate_actor did db in
10
-
let%lwt _ =
11
-
Sequencer.sequence_account db ~did ~active:false ~status:`Deactivated ()
12
-
in
13
+
let%lwt _ = deactivate_account ~did db in
13
14
Dream.empty `OK )
+25
-32
pegasus/lib/api/server/deleteAccount.ml
+25
-32
pegasus/lib/api/server/deleteAccount.ml
···
8
8
Sys.rmdir path )
9
9
else Sys.remove path
10
10
11
+
let delete_account ~did db =
12
+
let%lwt () =
13
+
try%lwt
14
+
Util.use_pool db (fun conn ->
15
+
Util.transact conn (fun () ->
16
+
let open Util.Syntax in
17
+
let$! () =
18
+
Data_store.Queries.delete_reserved_keys_by_did ~did conn
19
+
in
20
+
let$! () = Data_store.Queries.delete_actor ~did conn in
21
+
let user_db_file = Util.Constants.user_db_filepath did in
22
+
let user_blobs_dir = Util.Constants.user_blobs_location did in
23
+
( if Sys.file_exists user_db_file then
24
+
try Sys.remove user_db_file with _ -> () ) ;
25
+
( if Sys.file_exists user_blobs_dir then
26
+
try rm_rf user_blobs_dir with _ -> () ) ;
27
+
Lwt.return_ok () ) )
28
+
with e ->
29
+
Errors.(
30
+
log_exn e ;
31
+
internal_error ~msg:"failed to delete account" () )
32
+
in
33
+
Sequencer.sequence_account db ~did ~active:false ~status:`Deleted ()
34
+
11
35
let handler =
12
36
Xrpc.handler (fun {req; db; _} ->
13
37
let%lwt {did; password; token} = Xrpc.parse_body req request_of_yojson in
···
23
47
when String.starts_with ~prefix:"del-" auth_code
24
48
&& token = auth_code
25
49
&& Util.now_ms () < auth_expires_at ->
26
-
let%lwt () =
27
-
try%lwt
28
-
Util.use_pool db (fun conn ->
29
-
Util.transact conn (fun () ->
30
-
let open Util.Syntax in
31
-
let$! () =
32
-
Data_store.Queries.delete_reserved_keys_by_did ~did
33
-
conn
34
-
in
35
-
let$! () =
36
-
Data_store.Queries.delete_actor ~did conn
37
-
in
38
-
let user_db_file =
39
-
Util.Constants.user_db_filepath did
40
-
in
41
-
let user_blobs_dir =
42
-
Util.Constants.user_blobs_location did
43
-
in
44
-
( if Sys.file_exists user_db_file then
45
-
try Sys.remove user_db_file with _ -> () ) ;
46
-
( if Sys.file_exists user_blobs_dir then
47
-
try rm_rf user_blobs_dir with _ -> () ) ;
48
-
Lwt.return_ok () ) )
49
-
with e ->
50
-
Errors.(
51
-
log_exn e ;
52
-
internal_error ~msg:"failed to delete account" () )
53
-
in
54
-
let%lwt _ =
55
-
Sequencer.sequence_account db ~did ~active:false
56
-
~status:`Deleted ()
57
-
in
50
+
let%lwt _ = delete_account ~did db in
58
51
Dream.empty `OK
59
52
| None, _ | _, None ->
60
53
Errors.invalid_request ~name:"InvalidToken" "token is invalid"
+19
-20
pegasus/lib/api/server/requestAccountDelete.ml
+19
-20
pegasus/lib/api/server/requestAccountDelete.ml
···
1
+
let request_account_delete (actor : Data_store.Types.actor) db =
2
+
let did = actor.did in
3
+
let code =
4
+
"del-"
5
+
^ String.sub
6
+
Digestif.SHA256.(
7
+
digest_string (did ^ Int.to_string @@ Util.now_ms ()) |> to_hex )
8
+
0 8
9
+
in
10
+
let expires_at = Util.now_ms () + (15 * 60 * 1000) in
11
+
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
12
+
Util.send_email_or_log ~recipients:[To actor.email]
13
+
~subject:(Printf.sprintf "Account deletion request for %s" actor.handle)
14
+
~body:
15
+
(Plain
16
+
(Printf.sprintf "Delete your account using the following token: %s"
17
+
code ) )
18
+
1
19
let handler =
2
20
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
3
21
let did = Auth.get_authed_did_exn auth in
···
5
23
| None ->
6
24
Errors.internal_error ~msg:"actor not found" ()
7
25
| Some actor ->
8
-
let code =
9
-
"del-"
10
-
^ String.sub
11
-
Digestif.SHA256.(
12
-
digest_string (did ^ Int.to_string @@ Util.now_ms ())
13
-
|> to_hex )
14
-
0 8
15
-
in
16
-
let expires_at = Util.now_ms () + (15 * 60 * 1000) in
17
-
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
18
-
let%lwt () =
19
-
Util.send_email_or_log ~recipients:[To actor.email]
20
-
~subject:
21
-
(Printf.sprintf "Account deletion request for %s" actor.handle)
22
-
~body:
23
-
(Plain
24
-
(Printf.sprintf
25
-
"Delete your account using the following token: %s" code )
26
-
)
27
-
in
26
+
let%lwt () = request_account_delete actor db in
28
27
Dream.empty `OK )
+44
-26
pegasus/lib/api/server/requestEmailUpdate.ml
+44
-26
pegasus/lib/api/server/requestEmailUpdate.ml
···
1
1
type response = {token_required: bool [@key "tokenRequired"]}
2
2
[@@deriving yojson]
3
3
4
+
let request_email_update ?pending_email (actor : Data_store.Types.actor) db =
5
+
let token_required =
6
+
Option.is_none actor.email_confirmed_at || Option.is_some pending_email
7
+
in
8
+
let%lwt () =
9
+
if token_required then
10
+
let did = actor.did in
11
+
let code =
12
+
"eml-"
13
+
^ String.sub
14
+
Digestif.SHA256.(
15
+
digest_string (did ^ Int.to_string @@ Util.now_ms ()) |> to_hex )
16
+
0 8
17
+
in
18
+
let expires_at = Util.now_ms () + (10 * 60 * 1000) in
19
+
let%lwt () =
20
+
match pending_email with
21
+
| Some pending_email ->
22
+
Data_store.set_pending_email ~did ~code ~expires_at ~pending_email
23
+
db
24
+
| None ->
25
+
Data_store.set_auth_code ~did ~code ~expires_at db
26
+
in
27
+
let to_email =
28
+
(* if we're trying to change unconfirmed email, send confirmation to new email
29
+
to avoid e.g. getting stuck with an invalid email address *)
30
+
match (actor.email_confirmed_at, pending_email) with
31
+
| None, Some pending_email ->
32
+
pending_email
33
+
| _ ->
34
+
actor.email
35
+
in
36
+
Util.send_email_or_log ~recipients:[To to_email]
37
+
~subject:(Printf.sprintf "Email confirmation for %s" actor.handle)
38
+
~body:
39
+
(Plain
40
+
(Printf.sprintf
41
+
"Confirm your email address using the following token: %s" code )
42
+
)
43
+
else Lwt.return_unit
44
+
in
45
+
Lwt.return token_required
46
+
4
47
let handler =
5
48
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
6
49
Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email
···
10
53
| None ->
11
54
Errors.internal_error ~msg:"actor not found" ()
12
55
| 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
-
let%lwt () =
27
-
Util.send_email_or_log ~recipients:[To actor.email]
28
-
~subject:(Printf.sprintf "Email update for %s" actor.handle)
29
-
~body:
30
-
(Plain
31
-
(Printf.sprintf
32
-
"Confirm your email address using the following \
33
-
token: %s"
34
-
code ) )
35
-
in
36
-
Lwt.return_unit
37
-
else Lwt.return_unit
38
-
in
56
+
let%lwt token_required = request_email_update actor db in
39
57
Dream.json @@ Yojson.Safe.to_string
40
58
@@ response_to_yojson {token_required} )
+19
-21
pegasus/lib/api/server/requestPasswordReset.ml
+19
-21
pegasus/lib/api/server/requestPasswordReset.ml
···
1
1
type request = {email: string} [@@deriving yojson {strict= false}]
2
2
3
+
let request_password_reset (actor : Data_store.Types.actor) db =
4
+
let did = actor.did in
5
+
let code =
6
+
"pwd-"
7
+
^ String.sub
8
+
Digestif.SHA256.(
9
+
digest_string (did ^ Int.to_string @@ Util.now_ms ()) |> to_hex )
10
+
0 8
11
+
in
12
+
let expires_at = Util.now_ms () + (10 * 60 * 1000) in
13
+
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
14
+
Util.send_email_or_log ~recipients:[To actor.email]
15
+
~subject:(Printf.sprintf "Password reset for %s" actor.handle)
16
+
~body:
17
+
(Plain
18
+
(Printf.sprintf "Reset your password using the following token: %s"
19
+
code ) )
20
+
3
21
let handler =
4
22
Xrpc.handler (fun {req; auth; db; _} ->
5
23
let%lwt actor_opt =
···
25
43
(* always return success to prevent email enumeration *)
26
44
Dream.empty `OK
27
45
| 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
-
let%lwt () =
41
-
Util.send_email_or_log ~recipients:[To actor.email]
42
-
~subject:(Printf.sprintf "Password reset for %s" actor.handle)
43
-
~body:
44
-
(Plain
45
-
(Printf.sprintf
46
-
"Reset your password using the following token: %s" code )
47
-
)
48
-
in
46
+
let%lwt () = request_password_reset actor db in
49
47
Dream.empty `OK )
+24
-16
pegasus/lib/api/server/resetPassword.ml
+24
-16
pegasus/lib/api/server/resetPassword.ml
···
1
1
type request = {token: string; password: string}
2
2
[@@deriving yojson {strict= false}]
3
3
4
+
type reset_password_error = InvalidToken | ExpiredToken
5
+
6
+
let reset_password ~token ~password db =
7
+
match%lwt Data_store.get_actor_by_auth_code ~code:token db with
8
+
| None ->
9
+
Lwt.return_error InvalidToken
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 () = Data_store.update_password ~did:actor.did ~password db in
17
+
Lwt.return_ok actor.did
18
+
| _ ->
19
+
Lwt.return_error ExpiredToken )
20
+
4
21
let handler =
5
22
Xrpc.handler (fun {req; db; _} ->
6
23
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 ->
24
+
match%lwt reset_password ~token ~password db with
25
+
| Ok did ->
26
+
Dream.log "password reset completed for %s" did ;
27
+
Dream.empty `OK
28
+
| Error InvalidToken ->
9
29
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" ) )
30
+
| Error ExpiredToken ->
31
+
Errors.invalid_request ~name:"ExpiredToken" "token expired or invalid" )
+51
-25
pegasus/lib/api/server/updateEmail.ml
+51
-25
pegasus/lib/api/server/updateEmail.ml
···
4
4
; token: string option [@default None] }
5
5
[@@deriving yojson {strict= false}]
6
6
7
+
type update_email_error =
8
+
| TokenRequired
9
+
| ExpiredToken
10
+
| InvalidToken
11
+
| NoEmailProvided
12
+
13
+
let update_email ?email ~token (actor : Data_store.Types.actor) db =
14
+
let did = actor.did in
15
+
(* use provided email, or fall back to pending_email *)
16
+
let target_email =
17
+
match email with Some e -> Some e | None -> actor.pending_email
18
+
in
19
+
match target_email with
20
+
| None ->
21
+
Lwt.return_error NoEmailProvided
22
+
| Some email -> (
23
+
match actor.email_confirmed_at with
24
+
| Some _ -> (
25
+
(* email is confirmed, require valid token *)
26
+
match token with
27
+
| None ->
28
+
Lwt.return_error TokenRequired
29
+
| Some token -> (
30
+
match (actor.auth_code, actor.auth_code_expires_at) with
31
+
| Some auth_code, Some expires_at
32
+
when String.starts_with ~prefix:"eml-" auth_code
33
+
&& auth_code = token
34
+
&& Util.now_ms () < expires_at ->
35
+
let%lwt () = Data_store.update_email ~did ~email db in
36
+
Lwt.return_ok email
37
+
| Some _, Some expires_at when Util.now_ms () >= expires_at ->
38
+
Lwt.return_error ExpiredToken
39
+
| _ ->
40
+
Lwt.return_error InvalidToken ) )
41
+
| None ->
42
+
(* email not confirmed, no token required *)
43
+
let%lwt () = Data_store.update_email ~did ~email db in
44
+
Lwt.return_ok email )
45
+
7
46
let handler =
8
47
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
9
48
Auth.assert_account_scope auth ~attr:Oauth.Scopes.Email
···
15
54
| None ->
16
55
Errors.internal_error ~msg:"actor not found" ()
17
56
| Some actor -> (
18
-
match actor.email_confirmed_at with
19
-
| Some _ -> (
20
-
(* email is confirmed, require valid token *)
21
-
match token with
22
-
| None ->
23
-
Errors.invalid_request ~name:"TokenRequired"
24
-
"confirmation token required"
25
-
| Some token -> (
26
-
match (actor.auth_code, actor.auth_code_expires_at) with
27
-
| Some auth_code, Some expires_at
28
-
when String.starts_with ~prefix:"eml-" auth_code
29
-
&& auth_code = token
30
-
&& Util.now_ms () < expires_at ->
31
-
let%lwt () = Data_store.update_email ~did ~email db in
32
-
Dream.log "email updated for %s to %s" did email ;
33
-
Dream.empty `OK
34
-
| Some _, Some expires_at when Util.now_ms () >= expires_at ->
35
-
Errors.invalid_request ~name:"ExpiredToken" "token expired"
36
-
| _ ->
37
-
Errors.invalid_request ~name:"InvalidToken" "invalid token" ) )
38
-
| None ->
39
-
(* email not confirmed, no token required *)
40
-
let%lwt () = Data_store.update_email ~did ~email db in
41
-
Dream.log "email updated for %s to %s" did email ;
42
-
Dream.empty `OK ) )
57
+
match%lwt update_email ~email ~token actor db with
58
+
| Ok _ ->
59
+
Dream.empty `OK
60
+
| Error TokenRequired ->
61
+
Errors.invalid_request ~name:"TokenRequired"
62
+
"confirmation token required"
63
+
| Error ExpiredToken ->
64
+
Errors.invalid_request ~name:"ExpiredToken" "token expired"
65
+
| Error InvalidToken ->
66
+
Errors.invalid_request ~name:"InvalidToken" "invalid token"
67
+
| Error NoEmailProvided ->
68
+
Errors.invalid_request ~name:"InvalidRequest" "email is required" ) )
+18
-6
pegasus/lib/data_store.ml
+18
-6
pegasus/lib/data_store.ml
···
13
13
; created_at: int
14
14
; deactivated_at: int option
15
15
; auth_code: string option
16
-
; auth_code_expires_at: int option }
16
+
; auth_code_expires_at: int option
17
+
; pending_email: string option }
17
18
18
19
type invite_code = {code: string; did: string; remaining: int}
19
20
···
51
52
let get_actor_by_identifier id =
52
53
[%rapper
53
54
get_opt
54
-
{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}
55
+
{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}, @string?{pending_email}
55
56
FROM actors WHERE did = %string{id} OR handle = %string{id} OR email = %string{id}
56
57
LIMIT 1
57
58
|sql}
···
84
85
let list_actors =
85
86
[%rapper
86
87
get_many
87
-
{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}
88
+
{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}, @string?{pending_email}
88
89
FROM actors
89
90
WHERE did > %string{cursor}
90
91
AND deactivated_at IS NULL
···
168
169
WHERE did = %string{did}
169
170
|sql}]
170
171
172
+
let set_pending_email =
173
+
[%rapper
174
+
execute
175
+
{sql| UPDATE actors SET auth_code = %string{code}, auth_code_expires_at = %int{expires_at}, pending_email = %string{pending_email}
176
+
WHERE did = %string{did}
177
+
|sql}]
178
+
171
179
let clear_auth_code =
172
180
[%rapper
173
181
execute
174
-
{sql| UPDATE actors SET auth_code = NULL, auth_code_expires_at = NULL
182
+
{sql| UPDATE actors SET auth_code = NULL, auth_code_expires_at = NULL, pending_email = NULL
175
183
WHERE did = %string{did}
176
184
|sql}]
177
185
178
186
let get_actor_by_auth_code code =
179
187
[%rapper
180
188
get_opt
181
-
{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}
189
+
{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}, @string?{pending_email}
182
190
FROM actors WHERE auth_code = %string{code}
183
191
LIMIT 1
184
192
|sql}
···
195
203
let update_email =
196
204
[%rapper
197
205
execute
198
-
{sql| UPDATE actors SET email = %string{email}, email_confirmed_at = NULL, auth_code = NULL, auth_code_expires_at = NULL
206
+
{sql| UPDATE actors SET email = %string{email}, email_confirmed_at = NULL, auth_code = NULL, auth_code_expires_at = NULL, pending_email = NULL
199
207
WHERE did = %string{did}
200
208
|sql}]
201
209
···
340
348
(* 2fa *)
341
349
let set_auth_code ~did ~code ~expires_at conn =
342
350
Util.use_pool conn @@ Queries.set_auth_code ~did ~code ~expires_at
351
+
352
+
let set_pending_email ~did ~code ~expires_at ~pending_email conn =
353
+
Util.use_pool conn
354
+
@@ Queries.set_pending_email ~did ~code ~expires_at ~pending_email
343
355
344
356
let clear_auth_code ~did conn =
345
357
Util.use_pool conn @@ Queries.clear_auth_code ~did