1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
let encoding =
[| '0'
; '1'
; '2'
; '3'
; '4'
; '5'
; '6'
; '7'
; '8'
; '9'
; 'A'
; 'B'
; 'C'
; 'D'
; 'E'
; 'F'
; 'G'
; 'H'
; 'J'
; 'K'
; 'M'
; 'N'
; 'P'
; 'Q'
; 'R'
; 'S'
; 'T'
; 'V'
; 'W'
; 'X'
; 'Y'
; 'Z' |]
let encoding_len = Array.length encoding
let time_len = 10
let random_len = 16
let rng_init = ref false
let get_nocrypto_rng () =
let () =
if !rng_init = false then (
Nocrypto_entropy_unix.initialize () ;
rng_init := true )
in
let rng int = Nocrypto.Rng.Int.gen int in
rng
let random_char prng () =
let idx = prng encoding_len in
encoding.(idx)
let rec find_in_array a x n =
if n >= Array.length a then -1
else if a.(n) = x then n
else find_in_array a x (n + 1)
let encode_time now len =
let str = Buffer.create len in
let rec enc time length s =
if length = 0 then Buffer.contents s
else
let m = time mod encoding_len in
Buffer.add_char s encoding.(m) ;
enc ((time - m) / encoding_len) (length - 1) s
in
let s = enc now len str in
String.init len (fun i -> s.[len - 1 - i])
let encode_random len prng =
let str = Buffer.create len in
let rec enc length s =
if length = 0 then Buffer.contents s
else (
Buffer.add_char s (random_char prng ()) ;
enc (length - 1) s )
in
let s = enc len str in
String.init len (fun i -> s.[len - 1 - i])
let replace_char_at str idx c =
if idx > Bytes.length str - 1 then str
else
let () = Bytes.set str idx c in
str
let increment_base_32 str =
let initial = Bytes.of_string str in
let index = String.length str - 1 in
let max_char_index = encoding_len - 1 in
let rec incr finished curr_idx s f =
if finished || curr_idx < 0 then Bytes.to_string f
else
let char = Bytes.get s curr_idx in
let char_index = find_in_array encoding char 0 in
if char_index = max_char_index then
let new_s = replace_char_at s curr_idx encoding.(0) in
incr false (curr_idx - 1) new_s f
else
let new_f = replace_char_at s curr_idx encoding.(char_index + 1) in
incr true (curr_idx - 1) s new_f
in
incr false index initial initial
let get_now () = int_of_float (1000. *. Unix.gettimeofday ())
let ulid ?(seed_time = get_now ()) () =
let s = Buffer.create (time_len + random_len) in
Buffer.add_string s (encode_time seed_time time_len) ;
Buffer.add_string s (encode_random random_len (get_nocrypto_rng ())) ;
Buffer.contents s
let ulid_factory ?(prng = get_nocrypto_rng ()) () ?(seed_time = get_now ()) ()
=
let s = Buffer.create (time_len + random_len) in
Buffer.add_string s (encode_time seed_time time_len) ;
Buffer.add_string s (encode_random random_len prng) ;
Buffer.contents s
let monotonic_factory ?(prng = get_nocrypto_rng ()) () =
let last_time = ref 0 in
let last_random = ref "" in
fun ?(seed_time = get_now ()) () ->
let s = Buffer.create (time_len + random_len) in
let () =
if seed_time <= !last_time then
last_random := increment_base_32 !last_random
else (
last_time := seed_time ;
last_random := encode_random random_len prng )
in
Buffer.add_string s (encode_time !last_time time_len) ;
Buffer.add_string s !last_random ;
Buffer.contents s