8bit.lol
forked from
futur.blue/pegasus
objective categorical abstract machine language personal data server
futur.blue
1let leading_zeros_on_hash (key : string) : int =
2 let digest = Digestif.SHA256.(digest_string key |> to_raw_string) in
3 let rec loop idx zeros =
4 if idx >= String.length digest then zeros
5 else
6 let byte = Char.code digest.[idx] in
7 (* counting in 2-bit chunks, each byte can contain up to 4x 2-bit leading zeros *)
8 let zeros' =
9 zeros
10 +
11 if byte = 0 then 4
12 else if byte < 4 then 3
13 else if byte < 16 then 2
14 else if byte < 64 then 1
15 else 0
16 in
17 if byte = 0 then loop (idx + 1) zeros' else zeros'
18 in
19 loop 0 0
20
21let shared_prefix_length (a : string) (b : string) : int =
22 let rec loop idx =
23 if idx >= String.length a || idx >= String.length b then idx
24 else if a.[idx] = b.[idx] then loop (idx + 1)
25 else idx
26 in
27 loop 0
28
29let shared_prefix (a : string) (b : string) : string =
30 let len = shared_prefix_length a b in
31 String.sub a 0 len
32
33let valid_key_char_regex = Re.Pcre.regexp "^[a-zA-Z0-9_~\\-:.]*$"
34
35let is_valid_mst_key (key : string) : bool =
36 match String.split_on_char '/' key with
37 | [coll; rkey]
38 when String.length key <= 1024
39 && coll <> "" && rkey <> ""
40 && Re.execp valid_key_char_regex coll
41 && Re.execp valid_key_char_regex rkey ->
42 true
43 | _ ->
44 false
45
46let ensure_valid_key (key : string) : unit =
47 if not (is_valid_mst_key key) then raise (Invalid_argument "invalid mst key")
48
49let rec last (lst : 'a list) : 'a option =
50 match lst with [] -> None | [x] -> Some x | _ :: xs -> last xs
51
52let at_index i (lst : 'a list) : 'a option =
53 let rec aux j = function
54 | [] ->
55 None
56 | [x] ->
57 Some x
58 | x :: xs ->
59 if j = 0 then Some x else aux (j - 1) xs
60 in
61 aux i lst