8bit.lol
forked from
futur.blue/pegasus
objective categorical abstract machine language personal data server
futur.blue
1type t = string
2
3let charset = "234567abcdefghijklmnopqrstuvwxyz"
4
5let tid_regexp =
6 Re.Pcre.regexp "[234567abcdefghij][234567abcdefghijklmnopqrstuvwxyz]{12}"
7
8let is_valid (s : string) : bool =
9 match String.length s with
10 | 13 when Re.execp tid_regexp s ->
11 true
12 | _ ->
13 false
14
15let ensure_valid (tid : t) : unit =
16 if String.length tid <> 13 then
17 raise
18 (Invalid_argument
19 (Format.sprintf "invalid tid length %d: %s" (String.length tid) tid) )
20 else if not (Re.execp tid_regexp tid) then
21 raise (Invalid_argument (Format.sprintf "invalid tid format: %s" tid))
22
23let s32_encode (n : int64) : t =
24 let rec s32_encode ~tid n =
25 match n with
26 | 0L ->
27 tid
28 | n ->
29 s32_encode
30 ~tid:(String.make 1 charset.[Int64.to_int (Int64.rem n 32L)] ^ tid)
31 (Int64.unsigned_div n 32L)
32 in
33 s32_encode ~tid:"" n
34
35let s32_decode (s : t) : int64 =
36 let rec s32_decode ~(n : int64) (s : string) =
37 match s with
38 | s when String.length s > 0 ->
39 let c = s.[0] in
40 let cs = String.sub s 1 (String.length s - 1) in
41 s32_decode
42 ~n:
43 (Int64.add (Int64.mul n 32L)
44 (Int64.of_int (String.index charset c)) )
45 cs
46 | _ ->
47 n
48 in
49 s32_decode ~n:0L s
50
51let of_timestamp_us ?(clockid = Random.int_in_range ~min:0 ~max:1023)
52 (timestamp : int64) : t =
53 if timestamp < 0L || timestamp >= Int64.shift_left 1L 53 then
54 raise (Invalid_argument "timestamp must be within range [0, 2^53)") ;
55 if clockid < 0 || clockid > 1023 then
56 raise (Invalid_argument "clockid must be within range [0, 1023]") ;
57 let rec pad str len =
58 if String.length str >= len then str else pad ("2" ^ str) len
59 in
60 pad (s32_encode timestamp) 11 ^ pad (s32_encode @@ Int64.of_int clockid) 2
61
62let of_timestamp_ms ?(clockid = Random.int_in_range ~min:0 ~max:1023)
63 (timestamp : int64) : t =
64 of_timestamp_us
65 (Int64.add (Int64.mul timestamp 1000L) (Random.int64 1000L))
66 ~clockid
67
68let to_timestamp_us (tid : t) : int64 * int =
69 ensure_valid tid ;
70 let timestamp = s32_decode (String.sub tid 0 11) in
71 let clockid = Int64.to_int @@ s32_decode (String.sub tid 11 2) in
72 (timestamp, clockid)
73
74let to_timestamp_ms (tid : t) : int64 * int =
75 ensure_valid tid ;
76 let timestamp = s32_decode (String.sub tid 0 11) in
77 let clockid = Int64.to_int @@ s32_decode (String.sub tid 11 2) in
78 (Int64.div timestamp 1000L, clockid)
79
80let now () : t =
81 let calibrator = Lazy.force Time_stamp_counter.calibrator in
82 Time_stamp_counter.Calibrator.calibrate calibrator ;
83 Time_stamp_counter.now ()
84 |> Time_stamp_counter.to_time ~calibrator
85 |> Time_float_unix.to_span_since_epoch |> Time_float_unix.Span.to_us
86 |> Int64.of_float
87 |> of_timestamp_us ~clockid:(Random.int_in_range ~min:0 ~max:1023)
88
89let of_string (s : string) : t = ensure_valid s ; s
90
91let to_string (s : t) : string = s
92
93let of_yojson = function
94 | `String s ->
95 Ok (of_string s)
96 | _ ->
97 Error "expected string tid"
98
99let to_yojson s = `String (to_string s)
100
101let compare = String.compare
102
103let hash = Hashtbl.hash
104
105let equal = ( = )
106
107let pp fmt t = Format.fprintf fmt "%s" t