objective categorical abstract machine language personal data server
xrpc resolveHandle
+91
-3
+6
-3
bin/main.ml
+6
-3
bin/main.ml
···
11
11
( get
12
12
, "/xrpc/com.atproto.server.describeServer"
13
13
, Api.Server.DescribeServer.handler )
14
+
; ( get
15
+
, "/xrpc/com.atproto.identity.resolveHandle"
16
+
, Api.Identity.ResolveHandle.handler )
17
+
; ( get
18
+
, "/xrpc/com.atproto.sync.subscribeRepos"
19
+
, Api.Server.SubscribeRepos.handler )
14
20
; ( post
15
21
, "/xrpc/com.atproto.server.createSession"
16
22
, Api.Server.CreateSession.handler )
17
-
; ( get
18
-
, "/xrpc/com.atproto.sync.subscribeRepos"
19
-
, Api.Server.SubscribeRepos.handler )
20
23
; (* account *)
21
24
(get, "/xrpc/com.atproto.server.getSession", Api.Server.GetSession.handler)
22
25
; ( post
+1
dune-project
+1
dune-project
+1
pegasus.opam
+1
pegasus.opam
+22
pegasus/lib/api/identity/resolveHandle.ml
+22
pegasus/lib/api/identity/resolveHandle.ml
···
1
+
type response = {did: string} [@@deriving yojson {strict= false}]
2
+
3
+
let handler =
4
+
Xrpc.handler (fun {req; db; _} ->
5
+
let handle =
6
+
match Dream.query req "handle" with
7
+
| Some handle ->
8
+
handle
9
+
| None ->
10
+
Errors.invalid_request "missing parameter 'handle'"
11
+
in
12
+
match%lwt Data_store.get_actor_by_identifier handle db with
13
+
| Some actor ->
14
+
Dream.json @@ Yojson.Safe.to_string
15
+
@@ response_to_yojson {did= actor.did}
16
+
| None -> (
17
+
match%lwt Id_resolver.Handle.resolve handle with
18
+
| Ok did ->
19
+
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {did}
20
+
| Error e ->
21
+
Errors.log_exn (Failure e) ;
22
+
Errors.internal_error ~msg:"could not resolve handle" () ) )
+1
pegasus/lib/dune
+1
pegasus/lib/dune
+60
pegasus/lib/id_resolver.ml
+60
pegasus/lib/id_resolver.ml
···
1
+
open Cohttp_lwt
2
+
open Cohttp_lwt_unix
3
+
4
+
let did_regex =
5
+
Str.regexp {|^did:([a-z]+):([a-zA-Z0-9._:%\-]*[a-zA-Z0-9._\-])$|}
6
+
7
+
module Handle = struct
8
+
let dns_client = Dns_client_unix.create ()
9
+
10
+
let resolve_well_known handle =
11
+
try%lwt
12
+
let uri =
13
+
Uri.of_string ("https://" ^ handle ^ "/.well-known/atproto-did")
14
+
in
15
+
let%lwt _, body = Client.get uri in
16
+
let%lwt did = Body.to_string body in
17
+
Lwt.return_ok did
18
+
with exn -> Lwt.return_error (Printexc.to_string exn)
19
+
20
+
let resolve_dns handle =
21
+
try%lwt
22
+
match
23
+
Dns_client_unix.getaddrinfo dns_client Dns.Rr_map.Txt
24
+
(Domain_name.of_string_exn handle)
25
+
with
26
+
| Ok (_, t) -> (
27
+
let txt = Dns.Rr_map.Txt_set.choose t in
28
+
match Str.string_match did_regex txt 0 with
29
+
| true -> (
30
+
let method_name = Str.matched_group 1 txt in
31
+
let id = Str.matched_group 2 txt in
32
+
match method_name with
33
+
| "web" | "plc" ->
34
+
Lwt.return_ok ("did:" ^ method_name ^ ":" ^ id)
35
+
| _ ->
36
+
Lwt.return_error "unsupported method" )
37
+
| false ->
38
+
Lwt.return_error "invalid txt record" )
39
+
| Error (`Msg e) ->
40
+
Lwt.return_error e
41
+
with exn -> Lwt.return_error (Printexc.to_string exn)
42
+
43
+
let resolve handle =
44
+
(* run well-known and dns in parallel, error if they return different values, if only one returns just return that value *)
45
+
match%lwt Lwt.all [resolve_well_known handle; resolve_dns handle] with
46
+
| [Ok did1; Ok did2] when did1 = did2 ->
47
+
Lwt.return_ok did1
48
+
| [Ok _; Ok _] ->
49
+
Lwt.return_error "conflicting dids"
50
+
| [Ok did1; _] ->
51
+
Lwt.return_ok did1
52
+
| [_; Ok did2] ->
53
+
Lwt.return_ok did2
54
+
| [Error e1; Error e2] ->
55
+
Lwt.return_error
56
+
(Printf.sprintf
57
+
"well-known resolution error: %s\ndns resolution error: %s" e1 e2 )
58
+
| _ ->
59
+
Lwt.return_error "unexpected error"
60
+
end