[OCaml] High Intensity Training Online
fix pin the bcrypt work factor and surface corruption
The bcrypt adapter used safepass's default cost of 6, which is 64 iterations and far too cheap for a stored password verifier. Pin the cost at 12, the common baseline: a verification then costs on the order of a quarter second, so an offline attack on a leaked verifier pays that for every guess. A hash records its own cost, so existing verifiers keep verifying and the cost can be raised again later. A stored verifier that is not a bcrypt hash is corrupt storage, not a wrong password. Verification still fails closed, and now says so on stderr instead of reading the corruption as a typo. The test suite runs the service and web functors against a real bcrypt adapter at the minimum cost, so every registration and sign-in in the suite exercises the same code path without paying the production cost hundreds of times. The production adapter keeps its own unit tests, including one that reads the pinned cost back from a fresh hash.
Changed files
lib/persistence/bcrypt_hash.ml
@@ -1,7 +1,23 @@
1
1
(** Bcrypt implementation of the {!Hito_app.Password_hash.S} port, over
2
2
safepass. The one place that names a hashing algorithm. *)
3
3
4
Removed:
let hash password = Bcrypt.string_of_hash (Bcrypt.hash password)
4
Added:
(* The log2 work factor. safepass defaults to 6, which is far too cheap for a
5
Added:
stored password verifier; 12 is the common baseline and makes a verification
6
Added:
take on the order of a quarter second, so an offline attack against a leaked
7
Added:
verifier pays that cost for every guess. Raising this later is safe: a hash
8
Added:
records its own cost, so existing verifiers keep verifying. *)
9
Added:
let cost = 12
10
Added:
let hash password = Bcrypt.string_of_hash (Bcrypt.hash ~count:cost password)
5
11
12
Added:
(* A stored verifier that does not parse as a bcrypt hash is corrupt storage,
13
Added:
not a wrong password. safepass reports it from [verify], not from
14
Added:
[hash_of_string]. Refuse the sign-in (fail closed) but say so on stderr, so
15
Added:
the corruption is visible rather than read as a typo. *)
6
16
let verify ~hash password =
7
Removed:
try Bcrypt.verify password (Bcrypt.hash_of_string hash) with _ -> false
17
Added:
match Bcrypt.verify password (Bcrypt.hash_of_string hash) with
18
Added:
| verified -> verified
19
Added:
| exception e ->
20
Added:
Printf.eprintf
21
Added:
"hito: stored password verifier is not a bcrypt hash: %s\n%!"
22
Added:
(Printexc.to_string e);
23
Added:
false
test/dune
@@ -20,4 +20,5 @@
20
20
caqti-lwt
21
21
caqti-lwt.unix
22
22
caqti-driver-sqlite3
23
Added:
safepass
23
24
uri))
test/test_bcrypt_hash.ml
@@ -35,6 +35,16 @@
35
35
Alcotest.(check bool)
36
36
"rejects garbage" false
37
37
(Bcrypt_hash.verify ~hash:"not a bcrypt hash" "anything") );
38
Added:
( "the production work factor is pinned high",
39
Added:
`Quick,
40
Added:
fun () ->
41
Added:
(* A bcrypt hash records its own cost in the prefix, $2y$NN$. safepass
42
Added:
defaults to 6, far too cheap for a stored verifier; production pins
43
Added:
12. Reading it back from a fresh hash proves the pin took effect. *)
44
Added:
let hash = Bcrypt_hash.hash "any password" in
45
Added:
Alcotest.(check bool)
46
Added:
"hash carries the pinned cost" true
47
Added:
(String.length hash > 7 && String.sub hash 4 2 = "12") );
38
48
]
39
49
40
50
let suite = [ ("bcrypt_hash", hash_tests) ]
test/test_hash.ml
@@ -0,0 +1,13 @@
1
Added:
(* A password-hash adapter for tests. It is real bcrypt at the minimum work
2
Added:
factor, so it exercises the same code path as production without paying the
3
Added:
production cost on every registration and sign-in in the suite. The
4
Added:
production adapter, {!Hito_persistence.Bcrypt_hash}, pins a high cost and
5
Added:
has its own unit tests. *)
6
Added:
7
Added:
let cost = 4
8
Added:
let hash password = Bcrypt.string_of_hash (Bcrypt.hash ~count:cost password)
9
Added:
10
Added:
let verify ~hash password =
11
Added:
match Bcrypt.verify password (Bcrypt.hash_of_string hash) with
12
Added:
| verified -> verified
13
Added:
| exception _ -> false
test/test_import_service.ml
@@ -5,8 +5,7 @@
5
5
against service.mli. *)
6
6
7
7
open Hito_app
8
Removed:
open Hito_persistence
9
Removed:
module S = Service.Make (Memory_repo) (Bcrypt_hash)
8
Added:
module S = Service.Make (Memory_repo) (Test_hash)
10
9
module WI = Workout_import
11
10
12
11
let run = Lwt_main.run
test/test_service.ml
@@ -2,8 +2,7 @@
2
2
scoped to a trainee and driven over Lwt against the in-memory repository. *)
3
3
4
4
open Hito_app
5
Removed:
open Hito_persistence
6
Removed:
module S = Service.Make (Memory_repo) (Bcrypt_hash)
5
Added:
module S = Service.Make (Memory_repo) (Test_hash)
7
6
module Stimulus = Evidence.Stimulus
8
7
module Workout = Evidence.Workout
9
8
test/test_sqlite_repo.ml
@@ -3,7 +3,7 @@
3
3
4
4
open Hito_app
5
5
open Hito_persistence
6
Removed:
module S = Service.Make (Sqlite_repo) (Bcrypt_hash)
6
Added:
module S = Service.Make (Sqlite_repo) (Test_hash)
7
7
module Stimulus = Evidence.Stimulus
8
8
module Workout = Evidence.Workout
9
9
test/web/support.ml
@@ -5,10 +5,9 @@
5
5
in-memory back end. *)
6
6
7
7
open Hito_app
8
Removed:
open Hito_persistence
9
8
10
9
module Handlers =
11
Removed:
Hito_web.Handlers.Make (Memory_repo) (Bcrypt_hash) (Hito_import.Hevy_csv)
10
Added:
Hito_web.Handlers.Make (Memory_repo) (Test_hash) (Hito_import.Hevy_csv)
12
11
13
12
(* A fresh, fully wired application: secret, in-memory sessions, routes.
14
13
Registration is opened here so the auth-flow tests can create trainees via