objective categorical abstract machine language personal data server
xrpc requestPlcOperationSignature, signPlcOperation
+174
-152
+8
-1
bin/main.ml
+8
-1
bin/main.ml
···
53
53
; ( post
54
54
, "/xrpc/com.atproto.identity.updateHandle"
55
55
, Api.Identity.UpdateHandle.handler )
56
-
; ( get
56
+
; (* plc *)
57
+
( get
57
58
, "/xrpc/com.atproto.identity.getRecommendedDidCredentials"
58
59
, Api.Identity.GetRecommendedDidCredentials.handler )
60
+
; ( post
61
+
, "/xrpc/com.atproto.identity.requestPlcOperationSignature"
62
+
, Api.Identity.RequestPlcOperationSignature.handler )
63
+
; ( post
64
+
, "/xrpc/com.atproto.identity.signPlcOperation"
65
+
, Api.Identity.SignPlcOperation.handler )
59
66
; ( post
60
67
, "/xrpc/com.atproto.identity.submitPlcOperation"
61
68
, Api.Identity.SubmitPlcOperation.handler )
+12
pegasus/lib/api/identity/requestPlcOperationSignature.ml
+12
pegasus/lib/api/identity/requestPlcOperationSignature.ml
···
1
+
let handler =
2
+
Xrpc.handler ~auth:Authorization (fun {auth; db; _} ->
3
+
let did = Auth.get_authed_did_exn auth in
4
+
let code =
5
+
"plc-"
6
+
^ Uuidm.to_string (Uuidm.v4_gen (Random.State.make_self_init ()) ())
7
+
in
8
+
let expires_at = Util.now_ms () + (60 * 60 * 1000) in
9
+
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
10
+
(* TODO: something that isn't this *)
11
+
Dream.log "auth code for %s: %s" did code ;
12
+
Dream.empty `OK )
+59
pegasus/lib/api/identity/signPlcOperation.ml
+59
pegasus/lib/api/identity/signPlcOperation.ml
···
1
+
type request =
2
+
{ token: string
3
+
; rotation_keys: string list option [@default None]
4
+
; verification_methods: Util.Did_doc_types.string_map option [@default None]
5
+
; also_known_as: string list option [@default None]
6
+
; services: Plc.service_map option [@default None] }
7
+
[@@deriving yojson {strict= false}]
8
+
9
+
type response = {operation: Plc.signed_operation}
10
+
[@@deriving yojson {strict= false}]
11
+
12
+
let handler =
13
+
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
14
+
let did = Auth.get_authed_did_exn auth in
15
+
Auth.assert_identity_scope auth ~attr:Oauth.Scopes.Any ;
16
+
if not (String.starts_with ~prefix:"did:plc:" did) then
17
+
Errors.invalid_request "this method is only for did:plc identities" ;
18
+
let%lwt input = Xrpc.parse_body req request_of_yojson in
19
+
match%lwt Data_store.get_actor_by_identifier did db with
20
+
| None ->
21
+
Errors.internal_error ~msg:"actor not found" ()
22
+
| Some actor -> (
23
+
match (actor.auth_code, actor.auth_code_expires_at) with
24
+
| Some auth_code, Some auth_expires_at
25
+
when String.starts_with ~prefix:"plc-" auth_code
26
+
&& input.token = auth_code
27
+
&& Util.now_ms () < auth_expires_at -> (
28
+
match%lwt Plc.get_audit_log did with
29
+
| Ok log ->
30
+
let latest = Mist.Util.last log |> Option.get in
31
+
let unsigned_op : Plc.unsigned_operation =
32
+
Operation
33
+
{ type'= "plc_operation"
34
+
; rotation_keys=
35
+
Option.value input.rotation_keys
36
+
~default:latest.operation.rotation_keys
37
+
; verification_methods=
38
+
Option.value input.verification_methods
39
+
~default:latest.operation.verification_methods
40
+
; also_known_as=
41
+
Option.value input.also_known_as
42
+
~default:latest.operation.also_known_as
43
+
; services=
44
+
Option.value input.services
45
+
~default:latest.operation.services
46
+
; prev= Some latest.cid }
47
+
in
48
+
let signing_key = Kleidos.parse_multikey_str actor.signing_key in
49
+
let signed_op = Plc.sign_operation signing_key unsigned_op in
50
+
let%lwt () = Data_store.clear_auth_code ~did db in
51
+
let res = {operation= signed_op} in
52
+
res |> response_to_yojson |> Yojson.Safe.to_string
53
+
|> Dream.json ~status:`OK
54
+
| Error err ->
55
+
Errors.internal_error ~msg:("failed to get audit log: " ^ err) ()
56
+
)
57
+
| _ ->
58
+
Errors.invalid_request ~name:"InvalidToken"
59
+
"token expired or invalid" ) )
+28
-3
pegasus/lib/data_store.ml
+28
-3
pegasus/lib/data_store.ml
···
6
6
; did: string
7
7
; handle: string
8
8
; email: string
9
+
; email_confirmed_at: int option
9
10
; password_hash: string
10
11
; signing_key: string
11
12
; preferences: Yojson.Safe.t
12
13
; created_at: int
13
-
; deactivated_at: int option }
14
+
; deactivated_at: int option
15
+
; auth_code: string option
16
+
; auth_code_expires_at: int option }
14
17
15
18
type invite_code = {code: string; did: string; remaining: int}
16
19
···
45
48
let get_actor_by_identifier id =
46
49
[%rapper
47
50
get_opt
48
-
{sql| SELECT @int{id}, @string{did}, @string{handle}, @string{email}, @string{password_hash}, @string{signing_key}, @Json{preferences}, @int{created_at}, @int?{deactivated_at}
51
+
{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}
49
52
FROM actors WHERE did = %string{id} OR handle = %string{id} OR email = %string{id}
50
53
LIMIT 1
51
54
|sql}
···
61
64
let list_actors =
62
65
[%rapper
63
66
get_many
64
-
{sql| SELECT @int{id}, @string{did}, @string{handle}, @string{email}, @string{password_hash}, @string{signing_key}, @Json{preferences}, @int{created_at}, @int?{deactivated_at}
67
+
{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}
65
68
FROM actors
66
69
WHERE did > %string{cursor}
67
70
AND deactivated_at IS NULL
···
99
102
RETURNING @int{remaining}
100
103
|sql}]
101
104
105
+
(* 2fa *)
106
+
let set_auth_code =
107
+
[%rapper
108
+
execute
109
+
{sql| UPDATE actors SET auth_code = %string{code}, auth_code_expires_at = %int{expires_at}
110
+
WHERE did = %string{did}
111
+
|sql}]
112
+
113
+
let clear_auth_code =
114
+
[%rapper
115
+
execute
116
+
{sql| UPDATE actors SET auth_code = NULL, auth_code_expires_at = NULL
117
+
WHERE did = %string{did}
118
+
|sql}]
119
+
102
120
(* firehose *)
103
121
let firehose_insert =
104
122
[%rapper
···
203
221
let get_invite ~code conn = Util.use_pool conn @@ Queries.get_invite ~code
204
222
205
223
let use_invite ~code conn = Util.use_pool conn @@ Queries.use_invite ~code
224
+
225
+
(* 2fa *)
226
+
let set_auth_code ~did ~code ~expires_at conn =
227
+
Util.use_pool conn @@ Queries.set_auth_code ~did ~code ~expires_at
228
+
229
+
let clear_auth_code ~did conn =
230
+
Util.use_pool conn @@ Queries.clear_auth_code ~did
206
231
207
232
(* firehose helpers *)
208
233
let append_firehose_event conn ~time ~t ~data : int Lwt.t =
+3
pegasus/lib/migrations/003_two_factor_auth.sql
+3
pegasus/lib/migrations/003_two_factor_auth.sql
+52
-148
pegasus/lib/plc.ml
+52
-148
pegasus/lib/plc.ml
···
10
10
type service = {type': string [@key "type"]; endpoint: string}
11
11
[@@deriving yojson {strict= false}]
12
12
13
+
type service_map = (string * service) list [@@deriving yojson {strict= false}]
14
+
15
+
let service_map_to_yojson map =
16
+
`Assoc (List.map (fun (k, v) -> (k, service_to_yojson v)) map)
17
+
18
+
let service_map_of_yojson = function
19
+
| `Assoc l ->
20
+
Ok
21
+
(List.map
22
+
(fun (k, v) ->
23
+
( k
24
+
, match service_of_yojson v with
25
+
| Ok s ->
26
+
s
27
+
| Error _ ->
28
+
Yojson.json_error ("invalid service " ^ k) ) )
29
+
l )
30
+
| _ ->
31
+
Error "invalid service map"
32
+
13
33
type credentials =
14
34
{ rotation_keys: string list [@key "rotationKeys"]
15
-
; verification_methods: (string * string) list [@key "verificationMethods"]
35
+
; verification_methods: string_map [@key "verificationMethods"]
16
36
; also_known_as: string list [@key "alsoKnownAs"]
17
-
; services: (string * service) list [@key "services"] }
37
+
; services: service_map }
18
38
[@@deriving yojson {strict= false}]
19
39
20
40
type unsigned_operation_op =
21
41
{ type': string [@key "type"]
22
42
; rotation_keys: string list [@key "rotationKeys"]
23
-
; verification_methods: (string * string) list [@key "verificationMethods"]
43
+
; verification_methods: string_map [@key "verificationMethods"]
24
44
; also_known_as: string list [@key "alsoKnownAs"]
25
-
; services: (string * service) list
26
-
; prev: string option }
45
+
; services: service_map
46
+
; prev: string_or_null }
27
47
[@@deriving yojson {strict= false}]
28
48
29
49
type unsigned_tombstone_op = {type': string [@key "type"]; prev: string}
···
32
52
type unsigned_operation =
33
53
| Operation of unsigned_operation_op
34
54
| Tombstone of unsigned_tombstone_op
35
-
[@@deriving yojson {strict= false}]
36
55
37
56
let unsigned_operation_to_yojson = function
38
-
| Operation
39
-
{type'; rotation_keys; verification_methods; also_known_as; services; prev}
40
-
->
41
-
`Assoc
42
-
[ ("type", `String type')
43
-
; ("rotationKeys", `List (List.map (fun k -> `String k) rotation_keys))
44
-
; ( "verificationMethods"
45
-
, `Assoc
46
-
(List.map
47
-
(fun ((k, v) : string * string) -> (k, `String v))
48
-
verification_methods ) )
49
-
; ("alsoKnownAs", `List (List.map (fun k -> `String k) also_known_as))
50
-
; ( "services"
51
-
, `Assoc
52
-
(List.map
53
-
(fun ((k, v) : string * service) ->
54
-
( k
55
-
, `Assoc
56
-
[ ("type", `String v.type')
57
-
; ("endpoint", `String v.endpoint) ] ) )
58
-
services ) )
59
-
; ("prev", match prev with Some p -> `String p | None -> `Null) ]
60
-
| Tombstone {type'; prev} ->
61
-
`Assoc [("type", `String type'); ("prev", `String prev)]
57
+
| Operation op ->
58
+
unsigned_operation_op_to_yojson op
59
+
| Tombstone op ->
60
+
unsigned_tombstone_op_to_yojson op
62
61
63
62
let unsigned_operation_of_yojson (json : Yojson.Safe.t) =
64
-
let open Yojson.Safe.Util in
65
-
let type' = json |> member "type" |> to_string in
66
-
let rotation_keys =
67
-
json |> member "rotationKeys" |> to_list |> List.map to_string
68
-
in
69
-
let verification_methods =
70
-
json
71
-
|> member "verificationMethods"
72
-
|> to_assoc
73
-
|> List.map (fun (key, value) -> (key, to_string value))
74
-
in
75
-
let also_known_as =
76
-
json |> member "alsoKnownAs" |> to_list |> List.map to_string
77
-
in
78
-
let services =
79
-
json |> member "services" |> to_assoc
80
-
|> List.map (fun (k, v) -> (k, Result.get_ok @@ service_of_yojson v))
81
-
in
82
-
let prev = json |> member "prev" |> to_string_option in
83
-
match type' with
63
+
match Yojson.Safe.Util.(json |> member "type" |> to_string) with
84
64
| "plc_operation" ->
85
-
Ok
86
-
(Operation
87
-
{ type'
88
-
; rotation_keys
89
-
; verification_methods
90
-
; also_known_as
91
-
; services
92
-
; prev } )
65
+
Result.map (fun op -> Operation op)
66
+
@@ unsigned_operation_op_of_yojson json
93
67
| "plc_tombstone" ->
94
-
Ok (Tombstone {type'; prev= Option.get prev})
95
-
| _ ->
96
-
Error ("invalid operation type " ^ type')
68
+
Result.map (fun op -> Tombstone op)
69
+
@@ unsigned_tombstone_op_of_yojson json
70
+
| typ ->
71
+
Error ("invalid operation type " ^ typ)
97
72
98
73
type signed_operation_op =
99
74
{ type': string [@key "type"]
100
75
; rotation_keys: string list [@key "rotationKeys"]
101
-
; verification_methods: (string * string) list [@key "verificationMethods"]
76
+
; verification_methods: string_map [@key "verificationMethods"]
102
77
; also_known_as: string list [@key "alsoKnownAs"]
103
-
; services: (string * service) list
104
-
; prev: string option
78
+
; services: service_map
79
+
; prev: string_or_null
105
80
; signature: string [@key "sig"] }
106
81
[@@deriving yojson {strict= false}]
107
82
···
112
87
type signed_operation =
113
88
| Operation of signed_operation_op
114
89
| Tombstone of signed_tombstone_op
115
-
[@@deriving yojson {strict= false}]
116
90
117
91
let signed_operation_to_yojson = function
118
-
| Operation
119
-
{ type'
120
-
; rotation_keys
121
-
; verification_methods
122
-
; also_known_as
123
-
; services
124
-
; prev
125
-
; signature } -> (
126
-
match
127
-
unsigned_operation_to_yojson
128
-
(Operation
129
-
{ type'
130
-
; rotation_keys
131
-
; verification_methods
132
-
; also_known_as
133
-
; services
134
-
; prev } )
135
-
with
136
-
| `Assoc fields ->
137
-
`Assoc (fields @ [("sig", `String signature)])
138
-
| _ ->
139
-
failwith "unexpected json structure" )
140
-
| Tombstone {type'; prev; signature} -> (
141
-
match unsigned_operation_to_yojson (Tombstone {type'; prev}) with
142
-
| `Assoc fields ->
143
-
`Assoc (fields @ [("sig", `String signature)])
144
-
| _ ->
145
-
failwith "unexpected json structure" )
92
+
| Operation op ->
93
+
signed_operation_op_to_yojson op
94
+
| Tombstone op ->
95
+
signed_tombstone_op_to_yojson op
146
96
147
97
let signed_operation_of_yojson (json : Yojson.Safe.t) =
148
-
let open Yojson.Safe.Util in
149
-
let type' = json |> member "type" |> to_string in
150
-
match type' with
98
+
match Yojson.Safe.Util.(json |> member "type" |> to_string) with
151
99
| "plc_operation" ->
152
-
let rotation_keys =
153
-
json |> member "rotationKeys" |> to_list |> List.map to_string
154
-
in
155
-
let verification_methods =
156
-
json
157
-
|> member "verificationMethods"
158
-
|> to_assoc
159
-
|> List.map (fun (k, v) -> (k, to_string v))
160
-
in
161
-
let also_known_as =
162
-
json |> member "alsoKnownAs" |> to_list |> List.map to_string
163
-
in
164
-
let services =
165
-
json |> member "services" |> to_assoc
166
-
|> List.map (fun (k, v) -> (k, Result.get_ok @@ service_of_yojson v))
167
-
in
168
-
let prev = json |> member "prev" |> to_string_option in
169
-
let signature = json |> member "sig" |> to_string in
170
-
Ok
171
-
(Operation
172
-
{ type'
173
-
; rotation_keys
174
-
; verification_methods
175
-
; also_known_as
176
-
; services
177
-
; prev
178
-
; signature } )
100
+
Result.map (fun op -> Operation op) (signed_operation_op_of_yojson json)
179
101
| "plc_tombstone" ->
180
-
let prev = json |> member "prev" |> to_string in
181
-
let signature = json |> member "sig" |> to_string in
182
-
Ok (Tombstone {type'; prev; signature})
183
-
| t ->
184
-
Error ("unexpected operation type " ^ t)
102
+
Result.map (fun op -> Tombstone op) (signed_tombstone_op_of_yojson json)
103
+
| typ ->
104
+
Error ("unexpected operation type " ^ typ)
185
105
186
106
type audit_log_operation =
187
107
{ signature: string [@key "sig"]
188
-
; prev: string option [@default None]
108
+
; prev: string_or_null
189
109
; type': string [@key "type"]
190
-
; services: (string * service) list
191
-
[@to_yojson
192
-
fun l -> `Assoc (List.map (fun (k, v) -> (k, service_to_yojson v)) l)]
193
-
[@of_yojson
194
-
function
195
-
| `Assoc fields ->
196
-
Ok
197
-
(List.filter_map
198
-
(fun (k, v) ->
199
-
match service_of_yojson v with
200
-
| Ok service ->
201
-
Some (k, service)
202
-
| _ ->
203
-
None )
204
-
fields )
205
-
| _ ->
206
-
Error "Expected object for services"]
110
+
; services: service_map
207
111
; also_known_as: string list [@key "alsoKnownAs"]
208
112
; rotation_keys: string list [@key "rotationKeys"]
209
113
; verification_methods: string_map [@key "verificationMethods"] }
···
286
190
; also_known_as= ["at://" ^ handle]
287
191
; services=
288
192
[ ( "atproto_pds"
289
-
, { type'= "AtprotoPersonalDataServer"
290
-
; endpoint= Env.host_endpoint } ) ] }
193
+
, {type'= "AtprotoPersonalDataServer"; endpoint= Env.host_endpoint} ) ]
194
+
}
291
195
292
196
let create_did (pds_rotation_key : Kleidos.key) (signing_did_key : string)
293
197
?(rotation_did_keys : string list option) handle : string * signed_operation
+12
pegasus/lib/util.ml
+12
pegasus/lib/util.ml
···
83
83
end
84
84
85
85
module Did_doc_types = struct
86
+
type string_or_null = string option
87
+
88
+
let string_or_null_to_yojson = function Some s -> `String s | None -> `Null
89
+
90
+
let string_or_null_of_yojson = function
91
+
| `String s ->
92
+
Ok (Some s)
93
+
| `Null ->
94
+
Ok None
95
+
| _ ->
96
+
Error "invalid field value"
97
+
86
98
type string_or_strings = [`String of string | `Strings of string list]
87
99
88
100
let string_or_strings_to_yojson = function