objective categorical abstract machine language personal data server
xrpc createAccount
+169
-24
+4
kleidos/kleidos.ml
+4
kleidos/kleidos.ml
+1
-23
pegasus/lib/api/identity/updateHandle.ml
+1
-23
pegasus/lib/api/identity/updateHandle.ml
···
1
1
type request = {handle: string} [@@deriving yojson]
2
2
3
-
let validate_handle handle =
4
-
if not @@ String.ends_with ~suffix:("." ^ Env.hostname) handle then
5
-
Error (Errors.InvalidRequestError ("InvalidHandle", "invalid handle suffix"))
6
-
else
7
-
let front =
8
-
String.sub handle 0
9
-
(String.length handle - (String.length Env.hostname + 1))
10
-
in
11
-
if String.contains front '.' then
12
-
Error
13
-
(Errors.InvalidRequestError
14
-
("InvalidHandle", "invalid characters in handle") )
15
-
else
16
-
match String.length front with
17
-
| l when l < 3 ->
18
-
Error
19
-
(Errors.InvalidRequestError ("InvalidHandle", "handle too short"))
20
-
| l when l > 18 ->
21
-
Error (Errors.InvalidRequestError ("InvalidHandle", "handle too long"))
22
-
| _ ->
23
-
Ok ()
24
-
25
3
let handler =
26
4
Xrpc.handler ~auth:Auth.Verifiers.authorization (fun {req; auth; db} ->
27
5
let did = Auth.get_authed_did_exn auth in
···
33
11
| Error _ ->
34
12
Errors.invalid_request "invalid request body"
35
13
in
36
-
match validate_handle handle with
14
+
match Util.validate_handle handle with
37
15
| Error e ->
38
16
raise e
39
17
| Ok () -> (
+102
pegasus/lib/api/repo/createAccount.ml
+102
pegasus/lib/api/repo/createAccount.ml
···
1
+
type request =
2
+
{ email: string
3
+
; handle: string
4
+
; did: string option
5
+
; password: string
6
+
; invite_code: string option [@key "inviteCode"]
7
+
; recovery_key: string option [@key "recoveryKey"] }
8
+
[@@deriving yojson {strict= false}]
9
+
10
+
type response =
11
+
{ access_jwt: string [@key "accessJwt"]
12
+
; refresh_jwt: string [@key "refreshJwt"]
13
+
; handle: string
14
+
; did: string }
15
+
[@@deriving yojson]
16
+
17
+
let handler =
18
+
Xrpc.handler (fun ctx ->
19
+
let%lwt input = Xrpc.parse_body ctx.req request_of_yojson in
20
+
if input.invite_code = None && Env.invite_required = true then
21
+
Errors.invalid_request ~name:"InvalidInviteCode"
22
+
"no invite code provided" ;
23
+
let () =
24
+
match Util.validate_handle input.handle with
25
+
| Ok _ ->
26
+
()
27
+
| Error e ->
28
+
raise e
29
+
in
30
+
let%lwt () =
31
+
match%lwt
32
+
Lwt.all
33
+
[ Data_store.get_actor_by_identifier input.email ctx.db
34
+
; Data_store.get_actor_by_identifier input.handle ctx.db ]
35
+
with
36
+
| [Some _; _] ->
37
+
Errors.invalid_request "an account with that email already exists"
38
+
| [_; Some _] ->
39
+
Errors.invalid_request "an account with that handle already exists"
40
+
| _ ->
41
+
Lwt.return ()
42
+
in
43
+
let signing_key, signing_pubkey = Kleidos.P256.generate_keypair () in
44
+
let%lwt did =
45
+
match input.did with
46
+
| Some did -> (
47
+
match%lwt Data_store.get_actor_by_identifier did ctx.db with
48
+
| Some _ ->
49
+
Errors.invalid_request "an account with that did already exists"
50
+
| None ->
51
+
Lwt.return did )
52
+
| None -> (
53
+
let sk_did = Kleidos.P256.pubkey_to_did_key signing_pubkey in
54
+
let rotation_did_keys =
55
+
[Kleidos.pubkey_to_did_key Env.rotation_key]
56
+
in
57
+
let rotation_did_keys =
58
+
match input.recovery_key with
59
+
| Some rk ->
60
+
rk :: rotation_did_keys
61
+
| None ->
62
+
rotation_did_keys
63
+
in
64
+
match%lwt
65
+
Plc.submit_genesis Env.rotation_key sk_did ~rotation_did_keys
66
+
input.handle
67
+
with
68
+
| Ok did ->
69
+
Lwt.return did
70
+
| Error e ->
71
+
failwith e )
72
+
in
73
+
let sk_priv_mk = Kleidos.P256.privkey_to_multikey signing_key in
74
+
let%lwt () =
75
+
Data_store.create_actor ~did ~handle:input.handle ~email:input.email
76
+
~password:input.password ~signing_key:sk_priv_mk ctx.db
77
+
in
78
+
let%lwt _ = User_store.connect ~create:true ~write:true did in
79
+
let%lwt repo = Repository.load ~write:true ~ds:ctx.db did in
80
+
let%lwt _ = Repository.put_initial_commit repo in
81
+
let%lwt _ =
82
+
Sequencer.sequence_identity ctx.db ~did ~handle:input.handle ()
83
+
in
84
+
let%lwt _ = Sequencer.sequence_account ctx.db ~did ~active:true () in
85
+
let%lwt {commit= commit_cid, commit; _} =
86
+
Repository.apply_writes repo [] None
87
+
in
88
+
let open User_store.Types in
89
+
let commit_block =
90
+
commit |> User_store.Types.signed_commit_to_yojson
91
+
|> Dag_cbor.encode_yojson
92
+
in
93
+
let block_stream = Lwt_seq.of_list [(commit_cid, commit_block)] in
94
+
let%lwt blocks =
95
+
Car.blocks_to_stream commit_cid block_stream |> Car.collect_stream
96
+
in
97
+
let%lwt _ =
98
+
Sequencer.sequence_sync ctx.db ~did ~rev:commit.rev ~blocks ()
99
+
in
100
+
let access_jwt, refresh_jwt = Auth.generate_jwt did in
101
+
Dream.json @@ Yojson.Safe.to_string
102
+
@@ response_to_yojson {access_jwt; refresh_jwt; did; handle= input.handle} )
+1
-1
pegasus/lib/data_store.ml
+1
-1
pegasus/lib/data_store.ml
···
196
196
197
197
let create_actor ~did ~handle ~email ~password ~signing_key conn =
198
198
let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in
199
-
let now = Unix.gettimeofday () *. 1000. |> int_of_float in
199
+
let now = Util.now_ms () in
200
200
let$! () =
201
201
Queries.create_actor ~did ~handle ~email ~password_hash ~signing_key
202
202
~created_at:now
+39
pegasus/lib/plc.ml
+39
pegasus/lib/plc.ml
···
134
134
| _ ->
135
135
failwith "unexpected json structure" )
136
136
137
+
let signed_operation_of_yojson (json : Yojson.Safe.t) =
138
+
let open Yojson.Safe.Util in
139
+
let type' = json |> member "type" |> to_string in
140
+
match type' with
141
+
| "plc_operation" ->
142
+
let rotation_keys =
143
+
json |> member "rotationKeys" |> to_list |> List.map to_string
144
+
in
145
+
let verification_methods =
146
+
json
147
+
|> member "verificationMethods"
148
+
|> to_assoc
149
+
|> List.map (fun (k, v) -> (k, v |> to_string))
150
+
in
151
+
let also_known_as =
152
+
json |> member "alsoKnownAs" |> to_list |> List.map to_string
153
+
in
154
+
let services =
155
+
json |> member "services" |> to_assoc
156
+
|> List.map (fun (k, v) -> (k, Result.get_ok @@ service_of_yojson v))
157
+
in
158
+
let prev = json |> member "prev" |> to_string_option in
159
+
let signature = json |> member "sig" |> to_string in
160
+
Ok
161
+
(Operation
162
+
{ type'
163
+
; rotation_keys
164
+
; verification_methods
165
+
; also_known_as
166
+
; services
167
+
; prev
168
+
; signature } )
169
+
| "plc_tombstone" ->
170
+
let prev = json |> member "prev" |> to_string in
171
+
let signature = json |> member "sig" |> to_string in
172
+
Ok (Tombstone {type'; prev; signature})
173
+
| t ->
174
+
Error ("unexpected operation type " ^ t)
175
+
137
176
type audit_log_operation =
138
177
{ signature: string [@key "sig"]
139
178
; prev: string option
+22
pegasus/lib/util.ml
+22
pegasus/lib/util.ml
···
261
261
262
262
(* returns whether the value is None *)
263
263
let is_none = function None -> true | _ -> false
264
+
265
+
let validate_handle handle =
266
+
if not @@ String.ends_with ~suffix:("." ^ Env.hostname) handle then
267
+
Error (Errors.InvalidRequestError ("InvalidHandle", "invalid handle suffix"))
268
+
else
269
+
let front =
270
+
String.sub handle 0
271
+
(String.length handle - (String.length Env.hostname + 1))
272
+
in
273
+
if String.contains front '.' then
274
+
Error
275
+
(Errors.InvalidRequestError
276
+
("InvalidHandle", "invalid characters in handle") )
277
+
else
278
+
match String.length front with
279
+
| l when l < 3 ->
280
+
Error
281
+
(Errors.InvalidRequestError ("InvalidHandle", "handle too short"))
282
+
| l when l > 18 ->
283
+
Error (Errors.InvalidRequestError ("InvalidHandle", "handle too long"))
284
+
| _ ->
285
+
Ok ()