futur.blue
objective categorical abstract machine language personal data server
Proxy getRecord to other PDSes if needed
+66
-12
pegasus/lib/api/repo/getRecord.ml
+66
-12
pegasus/lib/api/repo/getRecord.ml
···
11
11
let handler =
12
12
Xrpc.handler (fun ctx ->
13
13
let input = Xrpc.parse_query ctx.req query_of_yojson in
14
-
let%lwt input_did = Xrpc.resolve_repo_did ctx input.repo in
15
-
let%lwt repo = Repository.load ~ensure_active:true input_did in
16
-
let path = input.collection ^ "/" ^ input.rkey in
17
-
let uri = "at://" ^ input_did ^ "/" ^ path in
18
-
match%lwt Repository.get_record repo path with
19
-
| Some {cid; value; _}
20
-
when input.cid = None || input.cid = Some (Cid.to_string cid) ->
21
-
Dream.json @@ Yojson.Safe.to_string
22
-
@@ response_to_yojson {uri; cid= Cid.to_string cid; value}
23
-
| _ ->
14
+
try%lwt
15
+
let%lwt input_did = Xrpc.resolve_repo_did ctx input.repo in
16
+
let uri =
17
+
Util.make_at_uri ~repo:input_did ~collection:input.collection
18
+
~rkey:input.rkey ~fragment:None
19
+
in
20
+
let%lwt repo = Repository.load ~ensure_active:true input_did in
21
+
let path = input.collection ^ "/" ^ input.rkey in
22
+
match%lwt Repository.get_record repo path with
23
+
| Some {cid; value; _}
24
+
when input.cid = None || input.cid = Some (Cid.to_string cid) ->
25
+
Dream.json @@ Yojson.Safe.to_string
26
+
@@ response_to_yojson {uri; cid= Cid.to_string cid; value}
27
+
| _ ->
28
+
Errors.internal_error ~name:"RecordNotFound"
29
+
~msg:("could not find record " ^ uri)
30
+
()
31
+
with _ -> (
32
+
let%lwt input_did =
33
+
if String.starts_with ~prefix:"did:" input.repo then
34
+
Lwt.return input.repo
35
+
else
36
+
match%lwt Id_resolver.Handle.resolve input.repo with
37
+
| Ok did ->
38
+
Lwt.return did
39
+
| Error _ ->
40
+
Errors.invalid_request "failed to resolve repo"
41
+
in
42
+
let%lwt pds =
43
+
match%lwt Id_resolver.Did.resolve input_did with
44
+
| Ok doc -> (
45
+
Lwt.return
46
+
@@
47
+
match Id_resolver.Did.Document.get_service doc "#atproto_pds" with
48
+
| Some service ->
49
+
service
50
+
| None ->
51
+
Errors.invalid_request "failed to resolve repo pds" )
52
+
| Error _ ->
53
+
Errors.invalid_request "failed to resolve repo did document"
54
+
in
55
+
if pds = Env.host_endpoint then
24
56
Errors.internal_error ~name:"RecordNotFound"
25
-
~msg:("could not find record " ^ uri)
26
-
() )
57
+
~msg:("could not resolve user " ^ input.repo)
58
+
() ;
59
+
let get_uri = Uri.of_string pds in
60
+
let get_uri =
61
+
Uri.with_path get_uri "/xrpc/com.atproto.repo.getRecord"
62
+
in
63
+
let get_uri = Uri.with_query get_uri (Util.copy_query ctx.req) in
64
+
let%lwt res, body =
65
+
Util.http_get get_uri
66
+
~headers:(Cohttp.Header.of_list [("Accept", "application/json")])
67
+
in
68
+
match res.status with
69
+
| `OK ->
70
+
let%lwt json = Cohttp_lwt.Body.to_string body in
71
+
let%lwt () = Cohttp_lwt.Body.drain_body body in
72
+
Dream.json json
73
+
| _ ->
74
+
let%lwt () = Cohttp_lwt.Body.drain_body body in
75
+
Errors.internal_error ~name:"RecordNotFound"
76
+
~msg:
77
+
( "could not find record "
78
+
^ Util.make_at_uri ~repo:input.repo ~collection:input.collection
79
+
~rkey:input.rkey ~fragment:None )
80
+
() ) )
+9
-1
pegasus/lib/util.ml
+9
-1
pegasus/lib/util.ml
···
395
395
|> String.trim
396
396
397
397
let rec http_get ?(max_redirects = 5) ?headers uri =
398
-
let%lwt ans = Cohttp_lwt_unix.Client.get ?headers uri in
398
+
let ua = "pegasus (" ^ Env.host_endpoint ^ ")" in
399
+
let headers =
400
+
match headers with
401
+
| Some headers ->
402
+
Http.Header.add_unless_exists headers "User-Agent" ua
403
+
| None ->
404
+
Http.Header.of_list [("User-Agent", ua)]
405
+
in
406
+
let%lwt ans = Cohttp_lwt_unix.Client.get ~headers uri in
399
407
follow_redirect ~max_redirects uri ans
400
408
401
409
and follow_redirect ~max_redirects request_uri (response, body) =
+5
-7
pegasus/lib/xrpc.ml
+5
-7
pegasus/lib/xrpc.ml
···
328
328
Lwt.return res
329
329
330
330
let resolve_repo_did ctx repo =
331
-
if String.starts_with ~prefix:"did:" repo then Lwt.return repo
332
-
else
333
-
match%lwt Data_store.get_actor_by_identifier repo ctx.db with
334
-
| Some {did; _} ->
335
-
Lwt.return did
336
-
| None ->
337
-
Errors.invalid_request "target repository not found"
331
+
match%lwt Data_store.get_actor_by_identifier repo ctx.db with
332
+
| Some {did; _} ->
333
+
Lwt.return did
334
+
| None ->
335
+
Errors.invalid_request "target repository not found"
338
336
339
337
let resolve_repo_did_authed ctx repo =
340
338
let%lwt input_did = resolve_repo_did ctx repo in