objective categorical abstract machine language personal data server
xrpc reserveSigningKey, account delete/deactivate
+244
-8
+12
bin/main.ml
+12
bin/main.ml
···
69
69
; ( post
70
70
, "/xrpc/com.atproto.server.resetPassword"
71
71
, Api.Server.ResetPassword.handler )
72
+
; ( post
73
+
, "/xrpc/com.atproto.server.reserveSigningKey"
74
+
, Api.Server.ReserveSigningKey.handler )
75
+
; ( post
76
+
, "/xrpc/com.atproto.server.requestAccountDelete"
77
+
, Api.Server.RequestAccountDelete.handler )
78
+
; ( post
79
+
, "/xrpc/com.atproto.server.deleteAccount"
80
+
, Api.Server.DeleteAccount.handler )
81
+
; ( post
82
+
, "/xrpc/com.atproto.server.deactivateAccount"
83
+
, Api.Server.DeactivateAccount.handler )
72
84
; ( get
73
85
, "/xrpc/com.atproto.repo.listMissingBlobs"
74
86
, Api.Repo.ListMissingBlobs.handler )
+13
pegasus/lib/api/server/deactivateAccount.ml
+13
pegasus/lib/api/server/deactivateAccount.ml
···
1
+
type request = {delete_after: string option [@key "deleteAfter"] [@default None]}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
let handler =
5
+
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
6
+
let did = Auth.get_authed_did_exn auth in
7
+
(* TODO: handle delete_after *)
8
+
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
+
Dream.empty `OK )
+62
pegasus/lib/api/server/deleteAccount.ml
+62
pegasus/lib/api/server/deleteAccount.ml
···
1
+
type request = {did: string; password: string; token: string}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
let rec rm_rf path =
5
+
if Sys.is_directory path then (
6
+
Sys.readdir path
7
+
|> Array.iter (fun name -> rm_rf (Filename.concat path name)) ;
8
+
Sys.rmdir path )
9
+
else Sys.remove path
10
+
11
+
let handler =
12
+
Xrpc.handler (fun {req; db; _} ->
13
+
let%lwt {did; password; token} = Xrpc.parse_body req request_of_yojson in
14
+
match%lwt Data_store.get_actor_by_identifier did db with
15
+
| None ->
16
+
Errors.invalid_request "account not found"
17
+
| Some actor -> (
18
+
let password_hash = actor.password_hash |> Bcrypt.hash_of_string in
19
+
if not (Bcrypt.verify password password_hash) then
20
+
Errors.auth_required "invalid did or password" ;
21
+
match (actor.auth_code, actor.auth_code_expires_at) with
22
+
| Some auth_code, Some auth_expires_at
23
+
when String.starts_with ~prefix:"del-" auth_code
24
+
&& token = auth_code
25
+
&& 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
58
+
Dream.empty `OK
59
+
| None, _ | _, None ->
60
+
Errors.invalid_request ~name:"InvalidToken" "token is invalid"
61
+
| _ ->
62
+
Errors.invalid_request ~name:"ExpiredToken" "token is expired" ) )
+19
pegasus/lib/api/server/requestAccountDelete.ml
+19
pegasus/lib/api/server/requestAccountDelete.ml
···
1
+
let handler =
2
+
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
3
+
let did = Auth.get_authed_did_exn auth in
4
+
match%lwt Data_store.get_actor_by_identifier did db with
5
+
| None ->
6
+
Errors.internal_error ~msg:"actor not found" ()
7
+
| Some _actor ->
8
+
let code =
9
+
"del-"
10
+
^ String.sub
11
+
Digestif.SHA256.(
12
+
digest_string (did ^ Int.to_string @@ Util.now_ms ()) |> to_hex
13
+
)
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
+
Dream.log "account deletion code for %s: %s" did code ;
19
+
Dream.empty `OK )
+28
pegasus/lib/api/server/reserveSigningKey.ml
+28
pegasus/lib/api/server/reserveSigningKey.ml
···
1
+
type request = {did: string option [@default None]}
2
+
[@@deriving yojson {strict= false}]
3
+
4
+
type response = {signing_key: string [@key "signingKey"]} [@@deriving yojson]
5
+
6
+
let handler =
7
+
Xrpc.handler (fun {req; db; _} ->
8
+
let%lwt {did} = Xrpc.parse_body req request_of_yojson in
9
+
let%lwt existing =
10
+
match did with
11
+
| Some did when did <> "" ->
12
+
Data_store.get_reserved_key_by_did ~did db
13
+
| _ ->
14
+
Lwt.return_none
15
+
in
16
+
match existing with
17
+
| Some key ->
18
+
Dream.json @@ Yojson.Safe.to_string
19
+
@@ response_to_yojson {signing_key= key.key_did}
20
+
| None ->
21
+
let privkey, pubkey = Kleidos.K256.generate_keypair () in
22
+
let key_did = Kleidos.K256.pubkey_to_did_key pubkey in
23
+
let private_key = Kleidos.K256.privkey_to_multikey privkey in
24
+
let%lwt () =
25
+
Data_store.create_reserved_key ~key_did ~did ~private_key db
26
+
in
27
+
Dream.json @@ Yojson.Safe.to_string
28
+
@@ response_to_yojson {signing_key= key_did} )
+80
pegasus/lib/data_store.ml
+80
pegasus/lib/data_store.ml
···
18
18
type invite_code = {code: string; did: string; remaining: int}
19
19
20
20
type firehose_event = {seq: int; time: int; t: string; data: bytes}
21
+
22
+
type reserved_key =
23
+
{ key_did: string
24
+
; did: string option
25
+
; private_key: string
26
+
; created_at: int }
21
27
end
22
28
23
29
open Types
···
61
67
{sql| UPDATE actors SET deactivated_at = NULL WHERE did = %string{did}
62
68
|sql}]
63
69
70
+
let deactivate_actor =
71
+
[%rapper
72
+
execute
73
+
{sql| UPDATE actors SET deactivated_at = %int{deactivated_at} WHERE did = %string{did}
74
+
|sql}]
75
+
76
+
let delete_actor =
77
+
[%rapper
78
+
execute
79
+
{sql| DELETE FROM actors WHERE did = %string{did}
80
+
|sql}]
81
+
64
82
let update_actor_handle =
65
83
[%rapper
66
84
execute
···
108
126
RETURNING @int{remaining}
109
127
|sql}]
110
128
129
+
(* reserved keys *)
130
+
let create_reserved_key =
131
+
[%rapper
132
+
execute
133
+
{sql| INSERT INTO reserved_keys (key_did, did, private_key, created_at)
134
+
VALUES (%string{key_did}, %string?{did}, %string{private_key}, %int{created_at})
135
+
|sql}]
136
+
137
+
let get_reserved_key_by_did did =
138
+
[%rapper
139
+
get_opt
140
+
{sql| SELECT @string{key_did}, @string?{did}, @string{private_key}, @int{created_at}
141
+
FROM reserved_keys WHERE did = %string{did}
142
+
|sql}
143
+
record_out]
144
+
did
145
+
146
+
let get_reserved_key key_did =
147
+
[%rapper
148
+
get_opt
149
+
{sql| SELECT @string{key_did}, @string?{did}, @string{private_key}, @int{created_at}
150
+
FROM reserved_keys WHERE key_did = %string{key_did}
151
+
|sql}
152
+
record_out]
153
+
key_did
154
+
155
+
let delete_reserved_key =
156
+
[%rapper
157
+
execute
158
+
{sql| DELETE FROM reserved_keys WHERE key_did = %string{key_did}
159
+
|sql}]
160
+
161
+
let delete_reserved_keys_by_did =
162
+
[%rapper
163
+
execute
164
+
{sql| DELETE FROM reserved_keys WHERE did = %string{did}
165
+
|sql}]
166
+
111
167
(* 2fa *)
112
168
let set_auth_code =
113
169
[%rapper
···
218
274
219
275
let activate_actor did conn = Util.use_pool conn @@ Queries.activate_actor ~did
220
276
277
+
let deactivate_actor did conn =
278
+
let deactivated_at = Util.now_ms () in
279
+
Util.use_pool conn @@ Queries.deactivate_actor ~did ~deactivated_at
280
+
281
+
let delete_actor did conn = Util.use_pool conn @@ Queries.delete_actor ~did
282
+
221
283
let update_actor_handle ~did ~handle conn =
222
284
Util.use_pool conn @@ Queries.update_actor_handle ~did ~handle
223
285
···
246
308
let get_invite ~code conn = Util.use_pool conn @@ Queries.get_invite ~code
247
309
248
310
let use_invite ~code conn = Util.use_pool conn @@ Queries.use_invite ~code
311
+
312
+
(* reserved keys *)
313
+
let create_reserved_key ~key_did ~did ~private_key conn =
314
+
let created_at = Util.now_ms () in
315
+
Util.use_pool conn
316
+
@@ Queries.create_reserved_key ~key_did ~did ~private_key ~created_at
317
+
318
+
let get_reserved_key_by_did ~did conn =
319
+
Util.use_pool conn @@ Queries.get_reserved_key_by_did ~did
320
+
321
+
let get_reserved_key ~key_did conn =
322
+
Util.use_pool conn @@ Queries.get_reserved_key ~key_did
323
+
324
+
let delete_reserved_key ~key_did conn =
325
+
Util.use_pool conn @@ Queries.delete_reserved_key ~key_did
326
+
327
+
let delete_reserved_keys_by_did ~did conn =
328
+
Util.use_pool conn @@ Queries.delete_reserved_keys_by_did ~did
249
329
250
330
(* 2fa *)
251
331
let set_auth_code ~did ~code ~expires_at conn =
+8
pegasus/lib/migrations/004_reserved_keys.sql
+8
pegasus/lib/migrations/004_reserved_keys.sql
+22
-8
pegasus/lib/util.ml
+22
-8
pegasus/lib/util.ml
···
243
243
let module C = (val conn : Caqti_lwt.CONNECTION) in
244
244
match%lwt C.start () with
245
245
| Ok () -> (
246
-
match%lwt fn () with
247
-
| Ok _ -> (
248
-
match%lwt C.commit () with
249
-
| Ok () ->
250
-
Lwt.return_ok ()
246
+
try%lwt
247
+
match%lwt fn () with
248
+
| Ok _ -> (
249
+
match%lwt C.commit () with
250
+
| Ok () ->
251
+
Lwt.return_ok ()
252
+
| Error e -> (
253
+
match%lwt C.rollback () with
254
+
| Ok () ->
255
+
Lwt.return_error e
256
+
| Error e ->
257
+
Lwt.return_error e ) )
251
258
| Error e -> (
252
259
match%lwt C.rollback () with
253
260
| Ok () ->
254
261
Lwt.return_error e
255
262
| Error e ->
256
-
Lwt.return_error e ) )
257
-
| Error e -> (
263
+
Lwt.return_error e )
264
+
with e -> (
258
265
match%lwt C.rollback () with
259
266
| Ok () ->
260
-
Lwt.return_error e
267
+
Lwt.return_error
268
+
( match e with
269
+
| Caqti_error.Exn e ->
270
+
e
271
+
| e ->
272
+
Caqti_error.request_failed ~query:"unknown"
273
+
~uri:(Uri.of_string "//unknown")
274
+
(Caqti_error.Msg (Printexc.to_string e)) )
261
275
| Error e ->
262
276
Lwt.return_error e ) )
263
277
| Error e ->