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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
let base32_alphabet =
  [ "a"
  ; "b"
  ; "c"
  ; "d"
  ; "e"
  ; "f"
  ; "g"
  ; "h"
  ; "i"
  ; "j"
  ; "k"
  ; "l"
  ; "m"
  ; "n"
  ; "o"
  ; "p"
  ; "q"
  ; "r"
  ; "s"
  ; "t"
  ; "u"
  ; "v"
  ; "w"
  ; "x"
  ; "y"
  ; "z"
  ; "2"
  ; "3"
  ; "4"
  ; "5"
  ; "6"
  ; "7"
  ]


let reverse_base32_alphabet = function
  | 'a' ->
      0
  | 'b' ->
      1
  | 'c' ->
      2
  | 'd' ->
      3
  | 'e' ->
      4
  | 'f' ->
      5
  | 'g' ->
      6
  | 'h' ->
      7
  | 'i' ->
      8
  | 'j' ->
      9
  | 'k' ->
      10
  | 'l' ->
      11
  | 'm' ->
      12
  | 'n' ->
      13
  | 'o' ->
      14
  | 'p' ->
      15
  | 'q' ->
      16
  | 'r' ->
      17
  | 's' ->
      18
  | 't' ->
      19
  | 'u' ->
      20
  | 'v' ->
      21
  | 'w' ->
      22
  | 'x' ->
      23
  | 'y' ->
      24
  | 'z' ->
      25
  | '2' ->
      26
  | '3' ->
      27
  | '4' ->
      28
  | '5' ->
      29
  | '6' ->
      30
  | '7' ->
      31
  | wat ->
      failwith ("Invalid base32 character: " ^ Base.String.of_char wat)


let rec enc_loop data ~basis ~alphabet number =
  if number <= 0
  then data
  else
    let remainder = number mod basis in
    let result = number / basis in
    let digit = List.nth alphabet remainder in
    enc_loop (digit ^ data) ~basis ~alphabet result


let int_to_base_x ~basis ~alphabet number =
  if number < basis
  then List.nth alphabet number
  else enc_loop "" ~basis ~alphabet number


let base32_to_string ?(size = 10) base32 =
  base32
  |> Base.String.lowercase
  |> Base.String.to_list
  |> Base.List.filter ~f:(( != ) ' ')
  |> Base.List.map ~f:reverse_base32_alphabet
  |> Base.List.map ~f:(int_to_base_x ~basis:2 ~alphabet:[ "0"; "1" ])
  |> Base.List.map ~f:(Helpers.pad ~basis:5 ~direction:Helpers.OnLeft ~byte:'0')
  |> Base.List.reduce_exn ~f:( ^ )
  |> Z.of_string_base 2
  |> Mirage_crypto_pk.Z_extra.to_cstruct_be ~size
  |> Cstruct.to_string


let char_to_bits char =
  char
  |> Base.Char.to_int
  |> int_to_base_x ~basis:2 ~alphabet:[ "0"; "1" ]
  |> Helpers.pad ~basis:8 ~direction:Helpers.OnLeft ~byte:'0'


let bits_to_int bits = Z.to_int @@ Z.of_string_base 2 bits

let extract_to_base32 ~pos ~len bits =
  bits
  |> Base.String.sub ~pos ~len
  |> bits_to_int
  |> Base.List.nth_exn base32_alphabet


let bits_to_base32 bits =
  let len = 5 in
  let c1 = extract_to_base32 ~pos:0 ~len bits in
  let c2 = extract_to_base32 ~pos:5 ~len bits in
  let c3 = extract_to_base32 ~pos:10 ~len bits in
  let c4 = extract_to_base32 ~pos:15 ~len bits in
  let c5 = extract_to_base32 ~pos:20 ~len bits in
  let c6 = extract_to_base32 ~pos:25 ~len bits in
  let c7 = extract_to_base32 ~pos:30 ~len bits in
  let c8 = extract_to_base32 ~pos:35 ~len bits in
  c1 ^ c2 ^ c3 ^ c4 ^ " " ^ c5 ^ c6 ^ c7 ^ c8


let rec conv_loop ~idx ~max ~add buffer list =
  if idx >= max
  then buffer
  else
    let fst = char_to_bits @@ Base.List.nth_exn list (idx + 0) in
    let snd = char_to_bits @@ Base.List.nth_exn list (idx + 1) in
    let trd = char_to_bits @@ Base.List.nth_exn list (idx + 2) in
    let fth = char_to_bits @@ Base.List.nth_exn list (idx + 3) in
    let fft = char_to_bits @@ Base.List.nth_exn list (idx + 4) in
    let res = bits_to_base32 (fst ^ snd ^ trd ^ fth ^ fft) in
    conv_loop ~idx:(idx + add) ~max ~add (res :: buffer) list


let concat_with_space left right = left ^ " " ^ right

let string_to_base32 data =
  let padded = Helpers.pad ~basis:5 ~direction:Helpers.OnLeft data in
  let length = String.length padded in
  let chars = Base.String.to_list padded in
  let pieces = conv_loop ~idx:0 ~max:length ~add:5 [] chars in
  pieces
  |> Base.List.rev
  |> Base.List.reduce_exn ~f:concat_with_space
  |> Base.String.uppercase