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
module Internals = struct
let counter = Time.counter
let hmac = Hmac.hmac
let base32_to_string = Base32.base32_to_string
type padding = Helpers.padding
let pad = Helpers.pad
let padOnLeft = Helpers.padOnLeft
let padOnRight = Helpers.padOnRight
let truncate ~image ~digits =
let bytes =
Base.List.map ~f:Base.Char.to_int @@ Base.String.to_list image
in
let offset =
Base.List.nth_exn bytes (Base.List.length bytes - 1) land 0xf
in
let fst = (Base.List.nth_exn bytes (offset + 0) land 0x7f) lsl 24 in
let snd = (Base.List.nth_exn bytes (offset + 1) land 0xff) lsl 16 in
let trd = (Base.List.nth_exn bytes (offset + 2) land 0xff) lsl 8 in
let fth = (Base.List.nth_exn bytes (offset + 3) land 0xff) lsl 0 in
let num = fst lor snd lor trd lor fth mod Base.Int.pow 10 digits in
Helpers.pad ~basis:digits ~byte:'0' ~direction:Helpers.OnLeft
@@ Base.Int.to_string num
end
module type ITOTP = sig
val secret : ?bytes:int -> unit -> string
val code :
?window:int
-> ?drift:int
-> ?digits:int
-> ?hash:string
-> secret:string
-> unit
-> string
val verify :
?window:int
-> ?digits:int
-> ?hash:string
-> secret:string
-> code:string
-> unit
-> bool
end
module TOTP : ITOTP = struct
let secret ?(bytes = 10) () = Secret.generate ~bytes ()
let code
?(window = 30) ?(drift = 0) ?(digits = 6) ?(hash = "SHA-1") ~secret () =
assert (digits = 6 || digits = 8) ;
let decoded = Base32.base32_to_string secret in
let counter = Time.counter ~timestep:window ~drift () in
let image = Hmac.hmac ~hash ~secret:decoded counter in
Internals.truncate ~image ~digits
let verify
?(window = 30) ?(digits = 6) ?(hash = "SHA-1") ~secret ~code:number () =
number = code ~secret ~window ~digits ~hash ~drift:(-1) ()
|| number = code ~secret ~window ~digits ~hash ~drift:0 ()
|| number = code ~secret ~window ~digits ~hash ~drift:1 ()
end
module type IHOTP = sig
val secret : ?bytes:int -> unit -> string
val codes :
?digits:int
-> ?hash:string
-> ?amount:int
-> counter:int
-> secret:string
-> unit
-> string list
val verify :
?digits:int
-> ?hash:string
-> ?ahead:int
-> counter:int
-> secret:string
-> codes:string list
-> unit
-> bool * int
end
module HOTP : IHOTP = struct
let secret ?(bytes = 10) () = Secret.generate ~bytes ()
let code ~digits ~hash ~counter ~secret () =
let decoded = Base32.base32_to_string secret in
let counter = Base.Int64.of_int counter in
let counter' =
Cstruct.to_string
@@ Mirage_crypto_pk.Z_extra.to_cstruct_be ~size:8
@@ Z.of_int64 counter
in
let image = Hmac.hmac ~hash ~secret:decoded counter' in
Internals.truncate ~image ~digits
let codes ?(digits = 6) ?(hash = "SHA-1") ?(amount = 1) ~counter ~secret () =
assert (amount >= 1) ;
let step index = code ~digits ~hash ~counter:(counter + index) ~secret () in
Base.List.init amount ~f:step
let verify
?(digits = 6)
?(hash = "SHA-1")
?(ahead = 0)
~counter
~secret
~codes:numbers
() =
assert (ahead >= 0) ;
assert (Base.List.length numbers >= 1) ;
let amount = Base.List.length numbers in
let step index =
let valid =
numbers
= codes ~digits ~hash ~amount ~counter:(counter + index) ~secret ()
in
let next = counter + index + amount in
(valid, next)
in
let results = Base.List.init (ahead + 1) ~f:step in
let folding previous current =
if fst previous
then previous
else if fst current
then current
else (false, counter)
in
let invalid = (false, counter) in
Base.List.fold_left results ~init:invalid ~f:folding
end