[OCaml] High Intensity Training Online

refactor Move password hashing behind a port

Trainee no longer names a hashing library. Add a Password_hash.S port in the use-case layer and a Bcrypt_hash adapter over safepass in hito.persistence. Service.Make now takes the hasher as a functor argument (R)(H), and the four hash/verify call sites route through it. Handlers.Make forwards the hasher so the web tier still never names an algorithm. The credential stays opaque; only credential_of_hash/credential_to_hash remain on Trainee. hito.app now depends on hito.core and lwt only. Add Bcrypt_hash unit tests, including a malformed-hash case that verify now rejects instead of raising.

Commit
060df2194c5c296bf37a9185bcce832ab0ed0867
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
ARCHITECTURE.org
index 9557d5d4..abd3a121 100644..100644
@@ -309,9 +309,12 @@
309 309 ** Accounts and sessions
310 310
311 311 =Trainee= normalizes a username — trimmed, lowercased, 4 to 20 characters — and
312 Removed: holds a =credential= that carries a salted hash and never the password. Hashing
313 Removed: and constant-time verification happen inside that module through =safepass=, so
314 Removed: no other layer holds a plaintext password beyond a request.
312 Added: holds a =credential= that carries a salted hash and never the password. The
313 Added: =credential= is opaque and =Trainee= names no hashing library: the algorithm
314 Added: lives behind the =Password_hash.S= port, implemented by =Bcrypt_hash= over
315 Added: =safepass= in =hito.persistence=. =Service.Make= takes the hasher as a functor
316 Added: argument, so no layer above holds a plaintext password beyond a request, and the
317 Added: algorithm can change by swapping the adapter alone.
315 318
316 319 Passwords carry no length or content policy, so they never refuse registration.
317 320 Public sign-up is closed by default: =Handlers.make ?registration_open=
bin/main.ml
index 56bb9c3d..66ee58fa 100644..100644
@@ -20,8 +20,15 @@
20 20 the password from [HITO_SEED_PASSWORD]. Both are temporary until public
21 21 registration returns. *)
22 22
23 Removed: module Handlers = Hito_web.Handlers.Make (Hito_persistence.Sqlite_repo)
24 Removed: module Service = Hito_app.Service.Make (Hito_persistence.Sqlite_repo)
23 Added: module Handlers =
24 Added: Hito_web.Handlers.Make
25 Added: (Hito_persistence.Sqlite_repo)
26 Added: (Hito_persistence.Bcrypt_hash)
27 Added:
28 Added: module Service =
29 Added: Hito_app.Service.Make
30 Added: (Hito_persistence.Sqlite_repo)
31 Added: (Hito_persistence.Bcrypt_hash)
25 32
26 33 let getenv name default =
27 34 match Sys.getenv_opt name with Some v when v <> "" -> v | _ -> default
lib/app/dune
index e9af722e..307229f0 100644..100644
@@ -1,9 +1,9 @@
1 Removed: ; The use-case layer: entities' identity, the Repository port, the Service, and
2 Removed: ; the shared Catalog. It depends inward on hito.core only — no database, no web
3 Removed: ; framework — so the compiler forbids the Service from reaching an adapter.
4 Removed: ; safepass stays only until password hashing moves behind a port.
1 Added: ; The use-case layer: entities' identity, the Repository port, the Password_hash
2 Added: ; port, the Service, and the shared Catalog. It depends inward on hito.core only
3 Added: ; — no database, no web framework, no hashing library — so the compiler forbids
4 Added: ; the Service from reaching an adapter.
5 5
6 6 (library
7 7 (name hito_app)
8 8 (public_name hito.app)
9 Removed: (libraries hito.core lwt unix safepass))
9 Added: (libraries hito.core lwt))
lib/app/password_hash.ml
index 00000000..1b5d0e6b 000000..100644
@@ -0,0 +1,4 @@
1 Added: module type S = sig
2 Added: val hash : string -> string
3 Added: val verify : hash:string -> string -> bool
4 Added: end
lib/app/password_hash.mli
index 00000000..f648d677 000000..100644
@@ -0,0 +1,11 @@
1 Added: (** The password-hashing port. An adapter supplies a concrete algorithm, so the
2 Added: use case and the {!Trainee} entity never name one. The stored form is an
3 Added: opaque verifier string, wrapped by {!Trainee.credential_of_hash}. *)
4 Added:
5 Added: module type S = sig
6 Added: val hash : string -> string
7 Added: (** Salt and hash a new password into a stored verifier. *)
8 Added:
9 Added: val verify : hash:string -> string -> bool
10 Added: (** Constant-time check of a candidate password against a stored verifier. *)
11 Added: end
lib/app/service.ml
index 9b0d4960..0a610f2f 100644..100644
@@ -1,4 +1,4 @@
1 Removed: module Make (R : Repository.S) = struct
1 Added: module Make (R : Repository.S) (H : Password_hash.S) = struct
2 2 open Lwt.Infix
3 3
4 4 type t = { repo : R.t }
@@ -64,7 +64,7 @@
64 64 Lwt.return
65 65 (Result.map_error (fun e -> `Username e) (Trainee.username username))
66 66 in
67 Removed: let credential = Trainee.hash_password password in
67 Added: let credential = Trainee.credential_of_hash (H.hash password) in
68 68 Lwt_result.map_error
69 69 (fun `Username_taken -> `Username_taken)
70 70 (R.create_trainee t.repo ~username ~credential)
@@ -75,7 +75,9 @@
75 75 | Ok username -> (
76 76 R.find_trainee_by_username t.repo username >|= function
77 77 | Some trainee
78 Removed: when Trainee.verify_password trainee.Trainee.credential password ->
78 Added: when H.verify
79 Added: ~hash:(Trainee.credential_to_hash trainee.Trainee.credential)
80 Added: password ->
79 81 Some trainee
80 82 | _ -> None)
81 83
@@ -100,10 +102,15 @@
100 102 R.find_trainee t.repo id >>= function
101 103 | None -> Lwt.return (Error `Unknown)
102 104 | Some trainee ->
103 Removed: if not (Trainee.verify_password trainee.Trainee.credential current)
105 Added: if
106 Added: not
107 Added: (H.verify
108 Added: ~hash:(Trainee.credential_to_hash trainee.Trainee.credential)
109 Added: current)
104 110 then Lwt.return (Error `Incorrect_password)
105 111 else
106 Removed: R.update_credential t.repo id (Trainee.hash_password next)
112 Added: R.update_credential t.repo id
113 Added: (Trainee.credential_of_hash (H.hash next))
107 114 >|= fun updated -> Option.to_result ~none:`Unknown updated
108 115 end
109 116
lib/app/service.mli
index f07f51c3..cb3aa082 100644..100644
@@ -12,7 +12,7 @@
12 12 here means a native client cannot quietly adopt looser rules than the web
13 13 one. *)
14 14
15 Removed: module Make (R : Repository.S) : sig
15 Added: module Make (R : Repository.S) (_ : Password_hash.S) : sig
16 16 type t
17 17
18 18 val make : repo:R.t -> t
lib/app/trainee.ml
index 2bbf063e..c14a5d83 100644..100644
@@ -26,15 +26,9 @@
26 26
27 27 let username_to_string u = u
28 28
29 Removed: type credential = string (* the bcrypt hash string *)
29 Added: type credential = string (* an opaque password verifier string *)
30 30
31 31 let credential_of_hash h = h
32 32 let credential_to_hash h = h
33 Removed: let hash_password password = Bcrypt.string_of_hash (Bcrypt.hash password)
34 Removed:
35 Removed: let verify_password credential password =
36 Removed: match Bcrypt.hash_of_string credential with
37 Removed: | hash -> Bcrypt.verify password hash
38 Removed: | exception _ -> false
39 33
40 34 type t = { id : id; username : username; credential : credential }
lib/app/trainee.mli
index 96d4ac72..5093bdd5 100644..100644
@@ -2,9 +2,9 @@
2 2 logbook. Identity lives in {!Hito_app}, not the core, because the core needs
3 3 none.
4 4
5 Removed: A {!credential} is a password verifier, never the password. The hash is
6 Removed: computed and checked here so that no other layer sees a plaintext password
7 Removed: for longer than one request. *)
5 Added: A {!credential} is a password verifier, never the password. The hashing
6 Added: algorithm lives behind the {!Password_hash.S} port, so this entity binds to
7 Added: no hashing library. *)
8 8
9 9 type id = private string
10 10 (** An opaque account identity, assigned by an adapter. *)
@@ -31,20 +31,15 @@
31 31 val pp_username_error : Format.formatter -> username_error -> unit
32 32
33 33 type credential
34 Removed: (** A password verifier. Carries a salted hash, never the password. *)
34 Added: (** A password verifier. Carries a salted hash, never the password. The hashing
35 Added: algorithm is a {!Password_hash.S} adapter detail; this type only wraps the
36 Added: stored verifier so no other layer sees a plaintext password. *)
35 37
36 38 val credential_of_hash : string -> credential
37 39 (** Wraps a stored hash read back from persistence. *)
38 40
39 41 val credential_to_hash : credential -> string
40 42 (** The stored hash, for persistence. *)
41 Removed:
42 Removed: val hash_password : string -> credential
43 Removed: (** Salts and hashes a new password. Accepts any string; there is no length or
44 Removed: content policy on passwords. *)
45 Removed:
46 Removed: val verify_password : credential -> string -> bool
47 Removed: (** Constant-time verification of a candidate password against the verifier. *)
48 43
49 44 type t = { id : id; username : username; credential : credential }
50 45 (** A stored account. *)
lib/persistence/bcrypt_hash.ml
index 00000000..cbeda891 000000..100644
@@ -0,0 +1,7 @@
1 Added: (** Bcrypt implementation of the {!Hito_app.Password_hash.S} port, over
2 Added: safepass. The one place that names a hashing algorithm. *)
3 Added:
4 Added: let hash password = Bcrypt.string_of_hash (Bcrypt.hash password)
5 Added:
6 Added: let verify ~hash password =
7 Added: try Bcrypt.verify password (Bcrypt.hash_of_string hash) with _ -> false
lib/persistence/bcrypt_hash.mli
index 00000000..cd1b219b 000000..100644
@@ -0,0 +1,3 @@
1 Added: (** Bcrypt implementation of the password-hashing port. *)
2 Added:
3 Added: include Hito_app.Password_hash.S
lib/persistence/dune
index 72c721f7..82029e03 100644..100644
@@ -13,4 +13,5 @@
13 13 caqti-lwt
14 14 caqti-lwt.unix
15 15 caqti-driver-sqlite3
16 Removed: uri))
16 Added: uri
17 Added: safepass))
lib/web/handlers.ml
index 1558db2b..a5490215 100644..100644
@@ -1,8 +1,8 @@
1 1 open Lwt.Infix
2 2 open Hito_app
3 3
4 Removed: module Make (R : Repository.S) = struct
5 Removed: module Service = Service.Make (R)
4 Added: module Make (R : Repository.S) (H : Password_hash.S) = struct
5 Added: module Service = Service.Make (R) (H)
6 6
7 7 type t = {
8 8 service : Service.t;
lib/web/handlers.mli
index 4a0baddc..5ad5f157 100644..100644
@@ -2,7 +2,7 @@
2 2 the repository so tests drive it with an in-memory store while production
3 3 uses SQLite. *)
4 4
5 Removed: module Make (R : Hito_app.Repository.S) : sig
5 Added: module Make (R : Hito_app.Repository.S) (_ : Hito_app.Password_hash.S) : sig
6 6 type t
7 7
8 8 val make :
test/dune
index b473497a..6606bcd9 100644..100644
@@ -9,6 +9,7 @@
9 9 test_progression
10 10 test_service
11 11 test_codec
12 Added: test_bcrypt_hash
12 13 test_sqlite_repo
13 14 test_decode
14 15 test_web)
test/test_bcrypt_hash.ml
index 00000000..bb257216 000000..100644
@@ -0,0 +1,40 @@
1 Added: (** Tests for {!Hito_persistence.Bcrypt_hash} — the hashing adapter behind the
2 Added: {!Hito_app.Password_hash.S} port. *)
3 Added:
4 Added: open Hito_persistence
5 Added:
6 Added: let hash_tests =
7 Added: [
8 Added: ( "a hashed password verifies against itself",
9 Added: `Quick,
10 Added: fun () ->
11 Added: let hash = Bcrypt_hash.hash "correct horse battery staple" in
12 Added: Alcotest.(check bool)
13 Added: "verifies" true
14 Added: (Bcrypt_hash.verify ~hash "correct horse battery staple") );
15 Added: ( "a wrong password does not verify",
16 Added: `Quick,
17 Added: fun () ->
18 Added: let hash = Bcrypt_hash.hash "correct horse battery staple" in
19 Added: Alcotest.(check bool)
20 Added: "rejects" false
21 Added: (Bcrypt_hash.verify ~hash "Tr0ub4dor&3") );
22 Added: ( "hashing is salted: the same password hashes differently",
23 Added: `Quick,
24 Added: fun () ->
25 Added: let a = Bcrypt_hash.hash "same password" in
26 Added: let b = Bcrypt_hash.hash "same password" in
27 Added: Alcotest.(check bool) "distinct hashes" false (String.equal a b);
28 Added: Alcotest.(check bool)
29 Added: "both still verify" true
30 Added: (Bcrypt_hash.verify ~hash:a "same password"
31 Added: && Bcrypt_hash.verify ~hash:b "same password") );
32 Added: ( "a malformed stored hash never verifies",
33 Added: `Quick,
34 Added: fun () ->
35 Added: Alcotest.(check bool)
36 Added: "rejects garbage" false
37 Added: (Bcrypt_hash.verify ~hash:"not a bcrypt hash" "anything") );
38 Added: ]
39 Added:
40 Added: let suite = [ ("bcrypt_hash", hash_tests) ]
test/test_hito.ml
index 374e1986..511482f0 100644..100644
@@ -9,5 +9,5 @@
9 9 Alcotest.run "hito"
10 10 (Test_exercise.suite @ Test_recovery.suite @ Test_prescription.suite
11 11 @ Test_evidence.suite @ Test_progression.suite @ Test_service.suite
12 Removed: @ Test_codec.suite @ Test_sqlite_repo.suite @ Test_decode.suite
13 Removed: @ Test_web.suite)
12 Added: @ Test_codec.suite @ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite
13 Added: @ Test_decode.suite @ Test_web.suite)
test/test_service.ml
index f88c998b..895cd073 100644..100644
@@ -3,7 +3,7 @@
3 3
4 4 open Hito_app
5 5 open Hito_persistence
6 Removed: module S = Service.Make (Memory_repo)
6 Added: module S = Service.Make (Memory_repo) (Bcrypt_hash)
7 7 module Stimulus = Evidence.Stimulus
8 8 module Workout = Evidence.Workout
9 9
test/test_sqlite_repo.ml
index 97608314..e02d887c 100644..100644
@@ -3,7 +3,7 @@
3 3
4 4 open Hito_app
5 5 open Hito_persistence
6 Removed: module S = Service.Make (Sqlite_repo)
6 Added: module S = Service.Make (Sqlite_repo) (Bcrypt_hash)
7 7 module Stimulus = Evidence.Stimulus
8 8 module Workout = Evidence.Workout
9 9
test/test_web.ml
index e5585901..09f3cd67 100644..100644
@@ -4,7 +4,7 @@
4 4 stands in for SQLite; session storage is Dream's in-memory back end. *)
5 5
6 6 open Hito_persistence
7 Removed: module Handlers = Hito_web.Handlers.Make (Memory_repo)
7 Added: module Handlers = Hito_web.Handlers.Make (Memory_repo) (Bcrypt_hash)
8 8
9 9 (* A fresh, fully wired application: secret, in-memory sessions, routes.
10 10 Registration is opened here so the auth-flow tests can create trainees via