atproto libraries implementation in ocaml
gdiazlo.tngl.sh
1(** Identity Tool - Resolve handles/DIDs and verify AT Protocol identities.
2 Usage: identity_tool [--resolve-handle|--resolve-did|--verify] <identifier>
3*)
4
5open Atproto_syntax
6open Atproto_identity
7
8let http_get ~hcs_client uri =
9 let url = Uri.to_string uri in
10 match Hcs.Client.request hcs_client url with
11 | Ok resp -> Did_resolver.{ status = resp.status; body = resp.body }
12 | Error e ->
13 let msg =
14 match e with
15 | Hcs.Client.Connection_failed s -> "Connection failed: " ^ s
16 | Hcs.Client.Tls_error s -> "TLS error: " ^ s
17 | Hcs.Client.Protocol_error s -> "Protocol error: " ^ s
18 | Hcs.Client.Timeout -> "Timeout"
19 | Hcs.Client.Invalid_response s -> "Invalid response: " ^ s
20 | Hcs.Client.Too_many_redirects -> "Too many redirects"
21 in
22 Did_resolver.{ status = 0; body = msg }
23
24let run_with_hcs ~hcs_client f =
25 Effect.Deep.try_with f ()
26 {
27 effc =
28 (fun (type a) (eff : a Effect.t) ->
29 match eff with
30 | Did_resolver.Http_get uri ->
31 Some
32 (fun (k : (a, _) Effect.Deep.continuation) ->
33 Effect.Deep.continue k (http_get ~hcs_client uri))
34 | Handle_resolver.Http_get uri ->
35 Some
36 (fun k ->
37 let r = http_get ~hcs_client uri in
38 Effect.Deep.continue k
39 Handle_resolver.{ status = r.status; body = r.body })
40 | Handle_resolver.Dns_txt _ ->
41 Some
42 (fun k -> Effect.Deep.continue k Handle_resolver.Dns_not_found)
43 | _ -> None);
44 }
45
46let resolve_handle ~hcs_client h =
47 match Handle.of_string h with
48 | Error _ ->
49 Printf.printf "Error: Invalid handle\n";
50 1
51 | Ok handle ->
52 run_with_hcs ~hcs_client (fun () ->
53 match Handle_resolver.resolve handle with
54 | Error e ->
55 Printf.printf "Error: %s\n" (Handle_resolver.error_to_string e);
56 1
57 | Ok did ->
58 Printf.printf "Handle: %s\nDID: %s\n" (Handle.to_string handle)
59 (Did.to_string did);
60 0)
61
62let resolve_did ~hcs_client d =
63 match Did.of_string d with
64 | Error _ ->
65 Printf.printf "Error: Invalid DID\n";
66 1
67 | Ok did ->
68 run_with_hcs ~hcs_client (fun () ->
69 match Did_resolver.resolve_did did with
70 | Error e ->
71 Printf.printf "Error: %s\n" (Did_resolver.error_to_string e);
72 1
73 | Ok doc ->
74 Printf.printf "DID: %s\n" doc.id;
75 List.iter
76 (fun a -> Printf.printf "Handle: %s\n" a)
77 doc.also_known_as;
78 List.iter
79 (fun (v : Did_resolver.verification_method) ->
80 Printf.printf "Key: %s (%s)\n"
81 (Option.value ~default:"-" v.public_key_multibase)
82 v.type_)
83 doc.verification_method;
84 List.iter
85 (fun (s : Did_resolver.service) ->
86 Printf.printf "Service: %s -> %s\n" s.type_ s.service_endpoint)
87 doc.service;
88 0)
89
90let verify ~hcs_client id =
91 let is_did = String.length id > 4 && String.sub id 0 4 = "did:" in
92 run_with_hcs ~hcs_client (fun () ->
93 let result =
94 if is_did then
95 match Did.of_string id with
96 | Error _ -> Error "Invalid DID"
97 | Ok d ->
98 Identity.verify_did d |> Result.map_error Identity.error_to_string
99 else
100 match Handle.of_string id with
101 | Error _ -> Error "Invalid handle"
102 | Ok h ->
103 Identity.verify_handle h
104 |> Result.map_error Identity.error_to_string
105 in
106 match result with
107 | Error e ->
108 Printf.printf "FAILED: %s\n" e;
109 1
110 | Ok v ->
111 Printf.printf "PASSED\nDID: %s\nHandle: %s\n" (Did.to_string v.did)
112 (Handle.to_string v.handle);
113 Option.iter (Printf.printf "Key: %s\n") v.signing_key;
114 Option.iter
115 (fun u -> Printf.printf "PDS: %s\n" (Uri.to_string u))
116 v.pds_endpoint;
117 0)
118
119type mode = Resolve_handle | Resolve_did | Verify
120
121let cli =
122 let open Climate.Arg_parser in
123 let+ id =
124 pos_req 0 string ~value_name:"IDENTIFIER" ~doc:"Handle or DID to look up"
125 and+ rh = flag [ "H"; "resolve-handle" ] ~doc:"Resolve handle to DID"
126 and+ rd = flag [ "d"; "resolve-did" ] ~doc:"Resolve DID to document"
127 and+ _vf = flag [ "v"; "verify" ] ~doc:"Verify bidirectional identity" in
128 let mode =
129 if rh then Resolve_handle else if rd then Resolve_did else Verify
130 in
131 (mode, id)
132
133let () =
134 Mirage_crypto_rng_unix.use_default ();
135 Eio_main.run @@ fun env ->
136 Eio.Switch.run @@ fun sw ->
137 let config = Hcs.Client.default_config |> Hcs.Client.with_insecure_tls in
138 let hcs_client =
139 Hcs.Client.create ~sw ~net:(Eio.Stdenv.net env)
140 ~clock:(Eio.Stdenv.clock env) ~config ()
141 in
142 let mode, id =
143 Climate.Command.run
144 ~program_name:(Climate.Program_name.Literal "identity_tool")
145 (Climate.Command.singleton ~doc:"AT Protocol identity lookup tool" cli)
146 in
147 let result =
148 match mode with
149 | Resolve_handle -> resolve_handle ~hcs_client id
150 | Resolve_did -> resolve_did ~hcs_client id
151 | Verify -> verify ~hcs_client id
152 in
153 Hcs.Client.close hcs_client;
154 exit result