gdiazlo.tngl.sh
atproto libraries implementation in ocaml
1(** Handle Resolution for AT Protocol.
2
3 Handles are domain-based identifiers that resolve to DIDs. Resolution
4 follows this algorithm:
5
6 1. Query DNS TXT record at `_atproto.<handle>` 2. Look for record with
7 `did=<did>` value 3. If no DNS record, try HTTPS:
8 `https://<handle>/.well-known/atproto-did` 4. Response should be plain text
9 DID
10
11 This module uses the unified effects from {!Atproto_effects.Effects}. *)
12
13open Atproto_syntax
14module Effects = Atproto_effects.Effects
15
16(** {1 Types} *)
17
18(** Resolution errors *)
19type error =
20 | Invalid_handle of string
21 | Dns_error of string
22 | Http_error of int * string
23 | No_did_record
24 | Invalid_did of string
25 | Resolution_failed of string
26
27let error_to_string = function
28 | Invalid_handle msg -> Printf.sprintf "Invalid handle: %s" msg
29 | Dns_error msg -> Printf.sprintf "DNS error: %s" msg
30 | Http_error (status, body) -> Printf.sprintf "HTTP error %d: %s" status body
31 | No_did_record -> "No DID record found"
32 | Invalid_did msg -> Printf.sprintf "Invalid DID: %s" msg
33 | Resolution_failed msg -> Printf.sprintf "Resolution failed: %s" msg
34
35(** {1 Effects} *)
36
37(** DNS TXT query result - uses unified type *)
38type dns_result = Effects.dns_result =
39 | Dns_records of string list
40 | Dns_not_found
41 | Dns_failure of string
42
43type http_response = { status : int; body : string }
44(** HTTP GET response - local type for backward compatibility *)
45
46(** Effect for DNS TXT queries.
47
48 Note: This module also supports the unified {!Effects.Dns_txt} effect.
49 Handlers can match either this local effect or the unified one. *)
50type _ Effect.t += Dns_txt : string -> dns_result Effect.t
51
52(** Effect for HTTP GET requests.
53
54 Note: This module also supports the unified {!Effects.Http_get} effect. *)
55type _ Effect.t += Http_get : Uri.t -> http_response Effect.t
56
57(** Convert unified response to local type *)
58let of_unified_response (resp : Effects.http_response) : http_response =
59 { status = resp.Effects.status; body = resp.Effects.body }
60
61(** {1 Resolution} *)
62
63(** Parse a DID from a DNS TXT record value. Format: "did=did:plc:..." or just
64 the DID *)
65let parse_did_from_txt record =
66 let record = String.trim record in
67 if String.length record > 4 && String.sub record 0 4 = "did=" then
68 let did_str = String.sub record 4 (String.length record - 4) in
69 match Did.of_string did_str with Ok did -> Some did | Error _ -> None
70 else match Did.of_string record with Ok did -> Some did | Error _ -> None
71
72(** Resolve handle via DNS TXT record *)
73let resolve_via_dns handle =
74 let domain = "_atproto." ^ Handle.to_string handle in
75 match Effect.perform (Dns_txt domain) with
76 | Dns_not_found -> None
77 | Dns_failure _ -> None
78 | Dns_records records ->
79 (* Find first valid DID in records *)
80 List.find_map parse_did_from_txt records
81
82(** Resolve handle via HTTPS .well-known *)
83let resolve_via_https handle =
84 let url =
85 Printf.sprintf "https://%s/.well-known/atproto-did"
86 (Handle.to_string handle)
87 in
88 let uri = Uri.of_string url in
89 let response = Effect.perform (Http_get uri) in
90 if response.status = 200 then
91 let body = String.trim response.body in
92 match Did.of_string body with
93 | Ok did -> Ok did
94 | Error _ -> Error (Invalid_did body)
95 else if response.status = 404 then Error No_did_record
96 else Error (Http_error (response.status, response.body))
97
98(** Resolve a handle to a DID. Tries DNS first, then falls back to HTTPS. *)
99let resolve handle =
100 (* Try DNS first *)
101 match resolve_via_dns handle with
102 | Some did -> Ok did
103 | None -> (
104 (* Fall back to HTTPS *)
105 match resolve_via_https handle with
106 | Ok did -> Ok did
107 | Error No_did_record -> Error No_did_record
108 | Error e -> Error e)
109
110(** Resolve a handle string to a DID *)
111let resolve_string handle_str =
112 match Handle.of_string handle_str with
113 | Error _ -> Error (Invalid_handle handle_str)
114 | Ok handle -> resolve handle
115
116(** Resolve via DNS only (no HTTPS fallback) *)
117let resolve_dns_only handle =
118 match resolve_via_dns handle with
119 | Some did -> Ok did
120 | None -> Error No_did_record
121
122(** Resolve via HTTPS only (no DNS) *)
123let resolve_https_only handle = resolve_via_https handle