objective categorical abstract machine language personal data server
formatting
+73
-73
+49
-49
pegasus/lib/api/proxy/appBskyFeedGetFeed.ml
+49
-49
pegasus/lib/api/proxy/appBskyFeedGetFeed.ml
···
11
11
| None ->
12
12
Errors.invalid_request ("invalid feed URI " ^ input.feed)
13
13
| Some {repo; collection; rkey; _} -> (
14
-
match%lwt Id_resolver.Did.resolve repo with
15
-
| Error e ->
16
-
Errors.internal_error
17
-
~msg:("failed to resolve feed publisher " ^ repo ^ ": " ^ e)
14
+
match%lwt Id_resolver.Did.resolve repo with
15
+
| Error e ->
16
+
Errors.internal_error
17
+
~msg:("failed to resolve feed publisher " ^ repo ^ ": " ^ e)
18
+
()
19
+
| Ok did_doc -> (
20
+
let pds_host =
21
+
match
22
+
Option.bind
23
+
(Id_resolver.Did.Document.get_service did_doc "#atproto_pds")
24
+
(fun s -> s |> Uri.of_string |> Uri.host )
25
+
with
26
+
| Some endpoint ->
27
+
endpoint
28
+
| None ->
29
+
Errors.invalid_request "feed publisher has no PDS endpoint"
30
+
in
31
+
let get_record_uri =
32
+
Uri.make ~scheme:"https" ~host:pds_host
33
+
~path:"/xrpc/com.atproto.repo.getRecord"
34
+
~query:
35
+
[ ("repo", [repo])
36
+
; ("collection", [collection])
37
+
; ("rkey", [rkey]) ]
18
38
()
19
-
| Ok did_doc -> (
20
-
let pds_host =
21
-
match
22
-
Option.bind
23
-
(Id_resolver.Did.Document.get_service did_doc "#atproto_pds")
24
-
(fun s -> s |> Uri.of_string |> Uri.host )
25
-
with
26
-
| Some endpoint ->
27
-
endpoint
39
+
in
40
+
let%lwt res, body = Util.http_get get_record_uri in
41
+
match res.status with
42
+
| `OK -> (
43
+
let%lwt body_str = Cohttp_lwt.Body.to_string body in
44
+
let json = Yojson.Safe.from_string body_str in
45
+
let value = Yojson.Safe.Util.(json |> member "value") in
46
+
let feed_generator_did =
47
+
Yojson.Safe.Util.(value |> member "did" |> to_string_option)
48
+
in
49
+
match feed_generator_did with
28
50
| None ->
29
-
Errors.invalid_request "feed publisher has no PDS endpoint"
30
-
in
31
-
let get_record_uri =
32
-
Uri.make ~scheme:"https" ~host:pds_host
33
-
~path:"/xrpc/com.atproto.repo.getRecord"
34
-
~query:
35
-
[ ("repo", [repo])
36
-
; ("collection", [collection])
37
-
; ("rkey", [rkey]) ]
38
-
()
39
-
in
40
-
let%lwt res, body = Util.http_get get_record_uri in
41
-
match res.status with
42
-
| `OK -> (
43
-
let%lwt body_str = Cohttp_lwt.Body.to_string body in
44
-
let json = Yojson.Safe.from_string body_str in
45
-
let value = Yojson.Safe.Util.(json |> member "value") in
46
-
let feed_generator_did =
47
-
Yojson.Safe.Util.(value |> member "did" |> to_string_option)
48
-
in
49
-
match feed_generator_did with
51
+
Errors.invalid_request
52
+
"feed generator record missing 'did' field"
53
+
| Some fg_did -> (
54
+
match Dream.header ctx.req "atproto-proxy" with
55
+
| Some appview ->
56
+
Auth.assert_rpc_scope ctx.auth
57
+
~lxm:"app.bsky.feed.getFeed" ~aud:appview ;
58
+
Xrpc.service_proxy ctx ~aud:fg_did
59
+
~lxm:"app.bsky.feed.getFeedSkeleton"
50
60
| None ->
51
-
Errors.invalid_request
52
-
"feed generator record missing 'did' field"
53
-
| Some fg_did -> (
54
-
match Dream.header ctx.req "atproto-proxy" with
55
-
| Some appview ->
56
-
Auth.assert_rpc_scope ctx.auth
57
-
~lxm:"app.bsky.feed.getFeed" ~aud:appview ;
58
-
Xrpc.service_proxy ctx ~aud:fg_did
59
-
~lxm:"app.bsky.feed.getFeedSkeleton"
60
-
| None ->
61
-
Errors.invalid_request "missing proxy header" ) )
62
-
| _ ->
63
-
let%lwt () = Cohttp_lwt.Body.drain_body body in
64
-
Errors.internal_error
65
-
~msg:"failed to fetch feed generator record" () ) ) )
61
+
Errors.invalid_request "missing proxy header" ) )
62
+
| _ ->
63
+
let%lwt () = Cohttp_lwt.Body.drain_body body in
64
+
Errors.internal_error
65
+
~msg:"failed to fetch feed generator record" () ) ) )
+4
-3
pegasus/lib/api/server/confirmEmail.ml
+4
-3
pegasus/lib/api/server/confirmEmail.ml
···
1
-
type request = {email: string; token: string} [@@deriving yojson {strict= false}]
1
+
type request = {email: string; token: string}
2
+
[@@deriving yojson {strict= false}]
2
3
3
4
let handler =
4
5
Xrpc.handler ~auth:Authorization (fun {req; auth; db; _} ->
···
10
11
match%lwt Data_store.get_actor_by_identifier did db with
11
12
| None ->
12
13
Errors.invalid_request ~name:"AccountNotFound" "account not found"
13
-
| Some actor ->
14
+
| Some actor -> (
14
15
if String.lowercase_ascii actor.email <> email then
15
16
Errors.invalid_request ~name:"InvalidEmail" "email does not match"
16
-
else (
17
+
else
17
18
match (actor.auth_code, actor.auth_code_expires_at) with
18
19
| Some auth_code, Some expires_at
19
20
when String.starts_with ~prefix:"eml-" auth_code
+2
-2
pegasus/lib/api/server/requestAccountDelete.ml
+2
-2
pegasus/lib/api/server/requestAccountDelete.ml
+18
-19
pegasus/lib/api/server/updateEmail.ml
+18
-19
pegasus/lib/api/server/updateEmail.ml
···
17
17
| Some actor -> (
18
18
match actor.email_confirmed_at with
19
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
-
)
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" ) )
39
38
| None ->
40
39
(* email not confirmed, no token required *)
41
40
let%lwt () = Data_store.update_email ~did ~email db in