gdiazlo.tngl.sh
atproto libraries implementation in ocaml
1(** Handle validation for AT Protocol.
2
3 Handles are domain-name-based identifiers for AT Protocol users. They follow
4 DNS hostname rules with some restrictions.
5
6 Format: <label>.<label>...<label>
7 - At least 2 labels (no "dotless" TLDs)
8 - Each label: 1-63 ASCII alphanumeric characters or hyphens
9 - Labels cannot start or end with hyphens
10 - Total length: max 253 characters (including dots)
11 - Case-insensitive (normalized to lowercase)
12
13 Note: This does NOT use regex - all validation is hand-written. *)
14
15type t = string
16
17type error =
18 [ `Empty
19 | `Too_long
20 | `Invalid_char of char
21 | `Label_empty
22 | `Label_too_long
23 | `Label_starts_with_hyphen
24 | `Label_ends_with_hyphen
25 | `Single_label (* No dot = not a valid handle *)
26 | `Trailing_dot
27 | `Leading_dot
28 | `Consecutive_dots
29 | `Numeric_tld (* TLD cannot be purely numeric *) ]
30
31let pp_error fmt = function
32 | `Empty -> Format.fprintf fmt "handle is empty"
33 | `Too_long -> Format.fprintf fmt "handle exceeds 253 characters"
34 | `Invalid_char c -> Format.fprintf fmt "invalid character: %c" c
35 | `Label_empty -> Format.fprintf fmt "empty label"
36 | `Label_too_long -> Format.fprintf fmt "label exceeds 63 characters"
37 | `Label_starts_with_hyphen -> Format.fprintf fmt "label starts with hyphen"
38 | `Label_ends_with_hyphen -> Format.fprintf fmt "label ends with hyphen"
39 | `Single_label -> Format.fprintf fmt "handle must have at least two labels"
40 | `Trailing_dot -> Format.fprintf fmt "handle has trailing dot"
41 | `Leading_dot -> Format.fprintf fmt "handle has leading dot"
42 | `Consecutive_dots -> Format.fprintf fmt "handle has consecutive dots"
43 | `Numeric_tld -> Format.fprintf fmt "TLD cannot start with a digit"
44
45let error_to_string e = Format.asprintf "%a" pp_error e
46
47(** Check if a character is valid in a handle label *)
48let is_valid_char c =
49 (c >= 'a' && c <= 'z')
50 || (c >= 'A' && c <= 'Z')
51 || (c >= '0' && c <= '9')
52 || c = '-'
53
54(** Check if a string is purely numeric (all digits) *)
55let is_all_numeric s =
56 let len = String.length s in
57 if len = 0 then false
58 else begin
59 let rec check i =
60 if i >= len then true
61 else
62 let c = s.[i] in
63 if c >= '0' && c <= '9' then check (i + 1) else false
64 in
65 check 0
66 end
67
68(** Check if a string starts with a digit *)
69let starts_with_digit s = String.length s > 0 && s.[0] >= '0' && s.[0] <= '9'
70
71(** Validate a single label *)
72let validate_label (label : string) : (unit, error) result =
73 let len = String.length label in
74 if len = 0 then Error `Label_empty
75 else if len > 63 then Error `Label_too_long
76 else if label.[0] = '-' then Error `Label_starts_with_hyphen
77 else if label.[len - 1] = '-' then Error `Label_ends_with_hyphen
78 else begin
79 let rec check_chars i =
80 if i >= len then Ok ()
81 else
82 let c = label.[i] in
83 if is_valid_char c then check_chars (i + 1) else Error (`Invalid_char c)
84 in
85 check_chars 0
86 end
87
88(** Split a string into labels by '.' *)
89let split_labels (s : string) : string list = String.split_on_char '.' s
90
91(** Parse and validate a handle string *)
92let of_string (s : string) : (t, error) result =
93 let len = String.length s in
94 if len = 0 then Error `Empty
95 else if len > 253 then Error `Too_long
96 else if s.[0] = '.' then Error `Leading_dot
97 else if s.[len - 1] = '.' then Error `Trailing_dot
98 else if String.contains s ' ' then Error (`Invalid_char ' ')
99 else begin
100 (* Check for consecutive dots *)
101 let has_consecutive_dots =
102 let rec check i =
103 if i >= len - 1 then false
104 else if s.[i] = '.' && s.[i + 1] = '.' then true
105 else check (i + 1)
106 in
107 check 0
108 in
109 if has_consecutive_dots then Error `Consecutive_dots
110 else begin
111 let labels = split_labels s in
112 if List.length labels < 2 then Error `Single_label
113 else begin
114 (* Get the TLD (last label) and check it doesn't start with a digit *)
115 let tld = List.hd (List.rev labels) in
116 if starts_with_digit tld then Error `Numeric_tld
117 else begin
118 let rec validate_all = function
119 | [] -> Ok (String.lowercase_ascii s)
120 | label :: rest -> (
121 match validate_label label with
122 | Ok () -> validate_all rest
123 | Error e -> Error e)
124 in
125 validate_all labels
126 end
127 end
128 end
129 end
130
131(** Create a handle, raising Invalid_argument on failure *)
132let of_string_exn (s : string) : t =
133 match of_string s with
134 | Ok h -> h
135 | Error e -> invalid_arg (error_to_string e)
136
137(** Convert handle to string *)
138let to_string (h : t) : string = h
139
140(** Normalize a handle (lowercase) *)
141let normalize (h : t) : t = String.lowercase_ascii h
142
143(** Check if a string is a valid handle *)
144let is_valid (s : string) : bool =
145 match of_string s with Ok _ -> true | Error _ -> false
146
147(** Compare handles (case-insensitive) *)
148let compare (a : t) (b : t) : int =
149 String.compare (String.lowercase_ascii a) (String.lowercase_ascii b)
150
151(** Check handles for equality (case-insensitive) *)
152let equal (a : t) (b : t) : bool = compare a b = 0