[OCaml] High Intensity Training Online
feat Use usernames for sign-up
Replace email identity with normalized usernames to minimize collected user data.
Changed files
- ARCHITECTURE.md
- bin/main.ml
- lib/app/memory_repo.ml
- lib/app/migrations.ml
- lib/app/repository.ml
- lib/app/repository.mli
- lib/app/service.ml
- lib/app/service.mli
- lib/app/sqlite_repo.ml
- lib/app/trainee.ml
- lib/app/trainee.mli
- lib/web/handlers.ml
- lib/web/pages.ml
- test/test_service.ml
- test/test_sqlite_repo.ml
- test/test_web.ml
ARCHITECTURE.md
@@ -83,7 +83,7 @@
83
83
84
84
### Accounts, sessions, and storage
85
85
86
Removed:
- **Trainee** — an account: an opaque id, a normalized email, and a password
86
Added:
- **Trainee** — an account: an opaque id, a normalized username, and a password
87
87
credential. A credential carries a bcrypt hash, never the password, and the
88
88
hash is computed and checked inside this module through `safepass`.
89
89
- **Repository port** — trainee-scoped account, catalog, selection,
@@ -105,7 +105,7 @@
105
105
and rebuilds a `Evidence.Workout.t` by driving the same core constructors a
106
106
live session does. A prescription is not stored; it is found again by name in
107
107
the `Catalog`. This keeps the core unchanged and carries no serializers.
108
Removed:
- **Authentication** — `Handlers` verifies a local email and password, then
108
Added:
- **Authentication** — `Handlers` verifies a local username and password, then
109
109
stores the trainee id in a signed session. Every application route requires
110
110
an authenticated trainee and redirects to the sign-in page otherwise. Every
111
111
state-changing POST verifies a CSRF token; the token is signed, not stored.
@@ -212,7 +212,7 @@
212
212
Set `HITO_SECRET` in production. When it is unset, the server generates a random
213
213
secret for that run, so sessions do not survive a restart.
214
214
215
Removed:
Authentication is local email and password. A password is stored as a bcrypt
215
Added:
Authentication is local username and password. A password is stored as a bcrypt
216
216
hash. A session holds the trainee id in a signed cookie, backed by the
217
217
`dream_session` table. Every state-changing POST carries a signed CSRF token.
218
218
bin/main.ml
@@ -9,8 +9,8 @@
9
9
sessions do not survive a restart. Set it in production.
10
10
- HITO_PORT TCP port. Default: 8080
11
11
12
Removed:
The socket binds loopback only. Authentication is local email and password;
13
Removed:
sessions and CSRF tokens are signed with the secret. *)
12
Added:
The socket binds loopback only. Authentication is local username and
13
Added:
password; sessions and CSRF tokens are signed with the secret. *)
14
14
15
15
module Handlers = Hito_web.Handlers.Make (Hito_app.Sqlite_repo)
16
16
lib/app/memory_repo.ml
@@ -23,30 +23,30 @@
23
23
Hashtbl.replace t.states key s;
24
24
s
25
25
26
Removed:
let create_trainee t ~(email : Trainee.email) ~credential =
26
Added:
let create_trainee t ~(username : Trainee.username) ~credential =
27
27
match
28
28
List.find_opt
29
29
(fun (tr : Trainee.t) ->
30
30
String.equal
31
Removed:
(Trainee.email_to_string tr.email)
32
Removed:
(Trainee.email_to_string email))
31
Added:
(Trainee.username_to_string tr.username)
32
Added:
(Trainee.username_to_string username))
33
33
t.trainees
34
34
with
35
Removed:
| Some _ -> Lwt.return (Error `Email_taken)
35
Added:
| Some _ -> Lwt.return (Error `Username_taken)
36
36
| None ->
37
37
let id = Trainee.id (Printf.sprintf "t%d" t.next_trainee) in
38
38
t.next_trainee <- t.next_trainee + 1;
39
Removed:
let trainee = { Trainee.id; email; credential } in
39
Added:
let trainee = { Trainee.id; username; credential } in
40
40
t.trainees <- trainee :: t.trainees;
41
41
Lwt.return (Ok trainee)
42
42
43
Removed:
let find_trainee_by_email t (email : Trainee.email) =
43
Added:
let find_trainee_by_username t (username : Trainee.username) =
44
44
Lwt.return
45
45
(List.find_opt
46
46
(fun (tr : Trainee.t) ->
47
47
String.equal
48
Removed:
(Trainee.email_to_string tr.email)
49
Removed:
(Trainee.email_to_string email))
48
Added:
(Trainee.username_to_string tr.username)
49
Added:
(Trainee.username_to_string username))
50
50
t.trainees)
51
51
52
52
let find_trainee t id =
lib/app/migrations.ml
@@ -9,7 +9,7 @@
9
9
[
10
10
{|CREATE TABLE IF NOT EXISTS trainee (
11
11
id TEXT PRIMARY KEY,
12
Removed:
email TEXT NOT NULL UNIQUE,
12
Added:
username TEXT NOT NULL UNIQUE,
13
13
credential TEXT NOT NULL
14
14
)|};
15
15
{|CREATE TABLE IF NOT EXISTS active_routine (
lib/app/repository.ml
@@ -13,11 +13,11 @@
13
13
14
14
val create_trainee :
15
15
t ->
16
Removed:
email:Trainee.email ->
16
Added:
username:Trainee.username ->
17
17
credential:Trainee.credential ->
18
Removed:
(Trainee.t, [ `Email_taken ]) result Lwt.t
18
Added:
(Trainee.t, [ `Username_taken ]) result Lwt.t
19
19
20
Removed:
val find_trainee_by_email : t -> Trainee.email -> Trainee.t option Lwt.t
20
Added:
val find_trainee_by_username : t -> Trainee.username -> Trainee.t option Lwt.t
21
21
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
22
22
val list_routines : t -> (routine_id * Prescription.Routine.t) list
23
23
val find_routine : t -> routine_id -> Prescription.Routine.t option
lib/app/repository.mli
@@ -27,11 +27,11 @@
27
27
28
28
val create_trainee :
29
29
t ->
30
Removed:
email:Trainee.email ->
30
Added:
username:Trainee.username ->
31
31
credential:Trainee.credential ->
32
Removed:
(Trainee.t, [ `Email_taken ]) result Lwt.t
32
Added:
(Trainee.t, [ `Username_taken ]) result Lwt.t
33
33
34
Removed:
val find_trainee_by_email : t -> Trainee.email -> Trainee.t option Lwt.t
34
Added:
val find_trainee_by_username : t -> Trainee.username -> Trainee.t option Lwt.t
35
35
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
36
36
37
37
(** {2 Catalog} — shared, not trainee-scoped. *)
lib/app/service.ml
@@ -11,9 +11,9 @@
11
11
the end, so callers and {!Service.mli} see one flat service. *)
12
12
13
13
type register_error =
14
Removed:
[ `Email of Trainee.email_error
14
Added:
[ `Username of Trainee.username_error
15
15
| `Password of Trainee.password_error
16
Removed:
| `Email_taken ]
16
Added:
| `Username_taken ]
17
17
18
18
type error = Unknown_routine | Not_recovered of Recovery.readiness
19
19
@@ -53,13 +53,14 @@
53
53
54
54
(* --- accounts --- *)
55
55
module Accounts = struct
56
Removed:
let register t ~email ~password =
56
Added:
let register t ~username ~password =
57
57
let open Lwt_result.Syntax in
58
Removed:
(* Validate the address and password, then create the account. Each step
58
Added:
(* Validate the username and password, then create the account. Each step
59
59
short-circuits into the shared [register_error], so the happy path
60
60
reads top to bottom instead of nesting. *)
61
Removed:
let* email =
62
Removed:
Lwt.return (Result.map_error (fun e -> `Email e) (Trainee.email email))
61
Added:
let* username =
62
Added:
Lwt.return
63
Added:
(Result.map_error (fun e -> `Username e) (Trainee.username username))
63
64
in
64
65
let* credential =
65
66
Lwt.return
@@ -68,14 +69,14 @@
68
69
(Trainee.hash_password password))
69
70
in
70
71
Lwt_result.map_error
71
Removed:
(fun `Email_taken -> `Email_taken)
72
Removed:
(R.create_trainee t.repo ~email ~credential)
72
Added:
(fun `Username_taken -> `Username_taken)
73
Added:
(R.create_trainee t.repo ~username ~credential)
73
74
74
Removed:
let authenticate t ~email ~password =
75
Removed:
match Trainee.email email with
75
Added:
let authenticate t ~username ~password =
76
Added:
match Trainee.username username with
76
77
| Error _ -> Lwt.return None
77
Removed:
| Ok email -> (
78
Removed:
R.find_trainee_by_email t.repo email >|= function
78
Added:
| Ok username -> (
79
Added:
R.find_trainee_by_username t.repo username >|= function
79
80
| Some trainee
80
81
when Trainee.verify_password trainee.Trainee.credential password ->
81
82
Some trainee
lib/app/service.mli
@@ -21,21 +21,21 @@
21
21
(** {2 Accounts} *)
22
22
23
23
type register_error =
24
Removed:
[ `Email of Trainee.email_error
24
Added:
[ `Username of Trainee.username_error
25
25
| `Password of Trainee.password_error
26
Removed:
| `Email_taken ]
27
Removed:
(** Why registration was refused: a malformed email, a too-short password, or
28
Removed:
an address already in use. *)
26
Added:
| `Username_taken ]
27
Added:
(** Why registration was refused: a malformed username, a too-short password,
28
Added:
or a username already in use. *)
29
29
30
30
val register :
31
31
t ->
32
Removed:
email:string ->
32
Added:
username:string ->
33
33
password:string ->
34
34
(Trainee.t, register_error) result Lwt.t
35
35
36
36
val authenticate :
37
Removed:
t -> email:string -> password:string -> Trainee.t option Lwt.t
38
Removed:
(** [Some] only when the address is known and the password verifies. *)
37
Added:
t -> username:string -> password:string -> Trainee.t option Lwt.t
38
Added:
(** [Some] only when the username is known and the password verifies. *)
39
39
40
40
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
41
41
lib/app/sqlite_repo.ml
@@ -15,15 +15,15 @@
15
15
16
16
let insert_trainee =
17
17
(t3 string string string ->. unit)
18
Removed:
"INSERT INTO trainee (id, email, credential) VALUES (?, ?, ?)"
18
Added:
"INSERT INTO trainee (id, username, credential) VALUES (?, ?, ?)"
19
19
20
Removed:
let trainee_by_email =
20
Added:
let trainee_by_username =
21
21
(string ->? t3 string string string)
22
Removed:
"SELECT id, email, credential FROM trainee WHERE email = ?"
22
Added:
"SELECT id, username, credential FROM trainee WHERE username = ?"
23
23
24
24
let trainee_by_id =
25
25
(string ->? t3 string string string)
26
Removed:
"SELECT id, email, credential FROM trainee WHERE id = ?"
26
Added:
"SELECT id, username, credential FROM trainee WHERE id = ?"
27
27
28
28
let get_active =
29
29
(string ->? string)
@@ -89,34 +89,34 @@
89
89
90
90
(* --- accounts --- *)
91
91
92
Removed:
let create_trainee t ~email ~credential =
93
Removed:
let email_s = Trainee.email_to_string email in
92
Added:
let create_trainee t ~username ~credential =
93
Added:
let username_s = Trainee.username_to_string username in
94
94
let credential_s = Trainee.credential_to_hash credential in
95
95
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
96
Removed:
Db.find_opt Q.trainee_by_email email_s)
96
Added:
Db.find_opt Q.trainee_by_username username_s)
97
97
>>= function
98
Removed:
| Some _ -> Lwt.return (Error `Email_taken)
98
Added:
| Some _ -> Lwt.return (Error `Username_taken)
99
99
| None ->
100
100
let id = Printf.sprintf "t%d" t.next_trainee in
101
101
t.next_trainee <- t.next_trainee + 1;
102
102
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
103
Removed:
Db.exec Q.insert_trainee (id, email_s, credential_s))
104
Removed:
>|= fun () -> Ok { Trainee.id = Trainee.id id; email; credential }
103
Added:
Db.exec Q.insert_trainee (id, username_s, credential_s))
104
Added:
>|= fun () -> Ok { Trainee.id = Trainee.id id; username; credential }
105
105
106
Removed:
let trainee_of_row (id, email, credential) =
107
Removed:
match Trainee.email email with
108
Removed:
| Ok email ->
106
Added:
let trainee_of_row (id, username, credential) =
107
Added:
match Trainee.username username with
108
Added:
| Ok username ->
109
109
Some
110
110
{
111
111
Trainee.id = Trainee.id id;
112
Removed:
email;
112
Added:
username;
113
113
credential = Trainee.credential_of_hash credential;
114
114
}
115
115
| Error _ -> None
116
116
117
Removed:
let find_trainee_by_email t email =
117
Added:
let find_trainee_by_username t username =
118
118
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
119
Removed:
Db.find_opt Q.trainee_by_email (Trainee.email_to_string email))
119
Added:
Db.find_opt Q.trainee_by_username (Trainee.username_to_string username))
120
120
>|= function
121
121
| Some row -> trainee_of_row row
122
122
| None -> None
lib/app/trainee.ml
@@ -3,20 +3,17 @@
3
3
let id s = s
4
4
let id_to_string s = s
5
5
6
Removed:
type email = string
7
Removed:
type email_error = Empty | No_at_sign
6
Added:
type username = string
7
Added:
type username_error = Empty
8
8
9
Removed:
let pp_email_error ppf = function
10
Removed:
| Empty -> Format.pp_print_string ppf "an email address is required"
11
Removed:
| No_at_sign -> Format.pp_print_string ppf "that is not an email address"
9
Added:
let pp_username_error ppf = function
10
Added:
| Empty -> Format.pp_print_string ppf "a username is required"
12
11
13
Removed:
let email raw =
12
Added:
let username raw =
14
13
let normalized = String.trim raw |> String.lowercase_ascii in
15
Removed:
if String.length normalized = 0 then Error Empty
16
Removed:
else if not (String.contains normalized '@') then Error No_at_sign
17
Removed:
else Ok normalized
14
Added:
if String.length normalized = 0 then Error Empty else Ok normalized
18
15
19
Removed:
let email_to_string e = e
16
Added:
let username_to_string u = u
20
17
21
18
type credential = string (* the bcrypt hash string *)
22
19
@@ -36,4 +33,4 @@
36
33
| hash -> Bcrypt.verify password hash
37
34
| exception _ -> false
38
35
39
Removed:
type t = { id : id; email : email; credential : credential }
36
Added:
type t = { id : id; username : username; credential : credential }
lib/app/trainee.mli
@@ -12,16 +12,16 @@
12
12
val id : string -> id
13
13
val id_to_string : id -> string
14
14
15
Removed:
type email = private string
16
Removed:
(** A normalized email address: trimmed and lowercased. *)
15
Added:
type username = private string
16
Added:
(** A normalized username: trimmed and lowercased ASCII. *)
17
17
18
Removed:
type email_error = Empty | No_at_sign
18
Added:
type username_error = Empty
19
19
20
Removed:
val email : string -> (email, email_error) result
21
Removed:
(** Normalizes and validates an address. This is a syntactic check only. *)
20
Added:
val username : string -> (username, username_error) result
21
Added:
(** Normalizes and validates a username. Requires a nonempty value. *)
22
22
23
Removed:
val email_to_string : email -> string
24
Removed:
val pp_email_error : Format.formatter -> email_error -> unit
23
Added:
val username_to_string : username -> string
24
Added:
val pp_username_error : Format.formatter -> username_error -> unit
25
25
26
26
type credential
27
27
(** A password verifier. Carries a salted hash, never the password. *)
@@ -43,5 +43,5 @@
43
43
val verify_password : credential -> string -> bool
44
44
(** Constant-time verification of a candidate password against the verifier. *)
45
45
46
Removed:
type t = { id : id; email : email; credential : credential }
46
Added:
type t = { id : id; username : username; credential : credential }
47
47
(** A stored account. *)
lib/web/handlers.ml
@@ -31,13 +31,13 @@
31
31
let form_invalid = "The submitted form is not valid."
32
32
33
33
let registration : Service.register_error -> string = function
34
Removed:
| `Email e -> Format.asprintf "%a" Trainee.pp_email_error e
34
Added:
| `Username e -> Format.asprintf "%a" Trainee.pp_username_error e
35
35
| `Password Trainee.Too_short ->
36
36
Printf.sprintf "Use at least %d characters."
37
37
Trainee.password_min_length
38
Removed:
| `Email_taken -> "That email is already registered."
38
Added:
| `Username_taken -> "That username is already registered."
39
39
40
Removed:
let sign_in_failed = "That email and password do not match."
40
Added:
let sign_in_failed = "That username and password do not match."
41
41
let routine = Format.asprintf "%a" Service.pp_error
42
42
43
43
let log_error : Service.log_error -> string = function
@@ -85,8 +85,8 @@
85
85
Dream.form request >|= function
86
86
| `Ok fields -> (
87
87
let get k = List.assoc_opt k fields in
88
Removed:
match (get "email", get "password") with
89
Removed:
| Some email, Some password -> Ok (email, password)
88
Added:
match (get "username", get "password") with
89
Added:
| Some username, Some password -> Ok (username, password)
90
90
| _ -> Error `Bad_request)
91
91
| _ -> Error `Bad_request
92
92
@@ -117,8 +117,8 @@
117
117
| Error _ ->
118
118
html ~status:`Bad_Request
119
119
(Pages.register request ~error:Present.form_invalid ())
120
Removed:
| Ok (email, password) -> (
121
Removed:
Service.register t.service ~email ~password >>= function
120
Added:
| Ok (username, password) -> (
121
Added:
Service.register t.service ~username ~password >>= function
122
122
| Ok trainee -> establish request trainee
123
123
| Error err ->
124
124
html ~status:`Bad_Request
@@ -129,8 +129,8 @@
129
129
| Error _ ->
130
130
html ~status:`Bad_Request
131
131
(Pages.login request ~error:Present.form_invalid ())
132
Removed:
| Ok (email, password) -> (
133
Removed:
Service.authenticate t.service ~email ~password >>= function
132
Added:
| Ok (username, password) -> (
133
Added:
Service.authenticate t.service ~username ~password >>= function
134
134
| Some trainee -> establish request trainee
135
135
| None ->
136
136
html ~status:`Unauthorized
lib/web/pages.ml
@@ -29,8 +29,8 @@
29
29
[ class_ "account" ]
30
30
[
31
31
tag "span"
32
Removed:
[ class_ "account-email" ]
33
Removed:
[ txt "%s" (Trainee.email_to_string trainee.email) ];
32
Added:
[ class_ "account-username" ]
33
Added:
[ txt "%s" (Trainee.username_to_string trainee.username) ];
34
34
tag "form"
35
35
[ action Routes.logout; post_form; class_ "logout" ]
36
36
[
@@ -127,12 +127,14 @@
127
127
tag "div"
128
128
[ class_ "field" ]
129
129
[
130
Removed:
tag "label" [ Dream_html.string_attr "for" "email" ] [ txt "Email" ];
130
Added:
tag "label"
131
Added:
[ Dream_html.string_attr "for" "username" ]
132
Added:
[ txt "Username" ];
131
133
void "input"
132
134
[
133
Removed:
type_ "email";
134
Removed:
name "email";
135
Removed:
Dream_html.string_attr "id" "email";
135
Added:
type_ "text";
136
Added:
name "username";
137
Added:
Dream_html.string_attr "id" "username";
136
138
Dream_html.string_attr "autocomplete" "username";
137
139
required;
138
140
];
@@ -172,9 +174,6 @@
172
174
html_page ~active:"auth" "Register"
173
175
([
174
176
tag "h2" [] [ txt "Create an account" ];
175
Removed:
tag "p"
176
Removed:
[ class_ "doctrine-note" ]
177
Removed:
[ txt "One trainee, one logbook. Recovery is tracked per account." ];
178
177
credentials_form request ~submit:"Register" ~action_path:Routes.register;
179
178
tag "p" []
180
179
[
test/test_service.ml
@@ -24,7 +24,7 @@
24
24
let fixture () =
25
25
let s = S.make ~repo:(Memory_repo.create ()) in
26
26
let trainee =
27
Removed:
ok (run (S.register s ~email:"lifter@example.com" ~password:"heavyduty1"))
27
Added:
ok (run (S.register s ~username:"lifter" ~password:"heavyduty1"))
28
28
in
29
29
(s, trainee.Trainee.id)
30
30
@@ -53,10 +53,10 @@
53
53
fun () ->
54
54
let s = S.make ~repo:(Memory_repo.create ()) in
55
55
let trainee =
56
Removed:
ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1"))
56
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
57
57
in
58
58
match
59
Removed:
run (S.authenticate s ~email:"a@b.com" ~password:"heavyduty1")
59
Added:
run (S.authenticate s ~username:"alice" ~password:"heavyduty1")
60
60
with
61
61
| Some found ->
62
62
Alcotest.(check string)
@@ -69,27 +69,50 @@
69
69
fun () ->
70
70
let s = S.make ~repo:(Memory_repo.create ()) in
71
71
let _ =
72
Removed:
ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1"))
72
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
73
73
in
74
74
Alcotest.(check bool)
75
75
"rejected" true
76
76
(Option.is_none
77
Removed:
(run (S.authenticate s ~email:"a@b.com" ~password:"wrong"))) );
78
Removed:
( "a duplicate email is refused",
77
Added:
(run (S.authenticate s ~username:"alice" ~password:"wrong"))) );
78
Added:
( "a duplicate username is refused after normalization",
79
79
`Quick,
80
80
fun () ->
81
81
let s = S.make ~repo:(Memory_repo.create ()) in
82
82
let _ =
83
Removed:
ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1"))
83
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
84
84
in
85
Removed:
match run (S.register s ~email:"A@B.com" ~password:"another11") with
86
Removed:
| Error `Email_taken -> ()
87
Removed:
| _ -> Alcotest.fail "expected Email_taken" );
85
Added:
(* Trimming and lowercasing make " ALICE " the same username. *)
86
Added:
match
87
Added:
run (S.register s ~username:" ALICE " ~password:"another11")
88
Added:
with
89
Added:
| Error `Username_taken -> ()
90
Added:
| _ -> Alcotest.fail "expected Username_taken" );
91
Added:
( "a normalized username authenticates regardless of case or spacing",
92
Added:
`Quick,
93
Added:
fun () ->
94
Added:
let s = S.make ~repo:(Memory_repo.create ()) in
95
Added:
let _ =
96
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
97
Added:
in
98
Added:
Alcotest.(check bool)
99
Added:
"case- and space-insensitive login" true
100
Added:
(Option.is_some
101
Added:
(run
102
Added:
(S.authenticate s ~username:" Alice " ~password:"heavyduty1")))
103
Added:
);
104
Added:
( "an empty username is refused",
105
Added:
`Quick,
106
Added:
fun () ->
107
Added:
let s = S.make ~repo:(Memory_repo.create ()) in
108
Added:
match run (S.register s ~username:" " ~password:"heavyduty1") with
109
Added:
| Error (`Username Trainee.Empty) -> ()
110
Added:
| _ -> Alcotest.fail "expected Empty" );
88
111
( "a short password is refused",
89
112
`Quick,
90
113
fun () ->
91
114
let s = S.make ~repo:(Memory_repo.create ()) in
92
Removed:
match run (S.register s ~email:"a@b.com" ~password:"short") with
115
Added:
match run (S.register s ~username:"alice" ~password:"short") with
93
116
| Error (`Password Trainee.Too_short) -> ()
94
117
| _ -> Alcotest.fail "expected Too_short" );
95
118
( "two trainees keep separate logs",
@@ -97,11 +120,11 @@
97
120
fun () ->
98
121
let s = S.make ~repo:(Memory_repo.create ()) in
99
122
let a =
100
Removed:
(ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1")))
123
Added:
(ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
101
124
.Trainee.id
102
125
in
103
126
let b =
104
Removed:
(ok (run (S.register s ~email:"c@d.com" ~password:"heavyduty1")))
127
Added:
(ok (run (S.register s ~username:"bob" ~password:"heavyduty1")))
105
128
.Trainee.id
106
129
in
107
130
let _ = ok (run (S.begin_workout s a ~routine:ideal ~now:(day 1) ())) in
test/test_sqlite_repo.ml
@@ -50,7 +50,7 @@
50
50
let repo = connect uri in
51
51
let s = S.make ~repo in
52
52
let trainee =
53
Removed:
ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1"))
53
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
54
54
in
55
55
let id = trainee.Trainee.id in
56
56
let _ =
@@ -64,7 +64,7 @@
64
64
let repo = connect uri in
65
65
let s = S.make ~repo in
66
66
let found =
67
Removed:
run (S.authenticate s ~email:"a@b.com" ~password:"heavyduty1")
67
Added:
run (S.authenticate s ~username:"alice" ~password:"heavyduty1")
68
68
in
69
69
Alcotest.(check bool)
70
70
"account persisted" true (Option.is_some found);
@@ -85,11 +85,11 @@
85
85
let repo = connect uri in
86
86
let s = S.make ~repo in
87
87
let a =
88
Removed:
(ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1")))
88
Added:
(ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
89
89
.Trainee.id
90
90
in
91
91
let b =
92
Removed:
(ok (run (S.register s ~email:"c@d.com" ~password:"heavyduty1")))
92
Added:
(ok (run (S.register s ~username:"bob" ~password:"heavyduty1")))
93
93
.Trainee.id
94
94
in
95
95
let _ =
@@ -114,7 +114,7 @@
114
114
let repo = connect uri in
115
115
let s = S.make ~repo in
116
116
let t =
117
Removed:
(ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1")))
117
Added:
(ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
118
118
.Trainee.id
119
119
in
120
120
let _ =
@@ -154,13 +154,13 @@
154
154
let repo = connect uri in
155
155
let s = S.make ~repo in
156
156
let trainee =
157
Removed:
ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1"))
157
Added:
ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
158
158
in
159
159
Alcotest.(check bool)
160
160
"usable after reconnect" true
161
161
(Option.is_some
162
162
(run
163
Removed:
(S.authenticate s ~email:"a@b.com" ~password:"heavyduty1")));
163
Added:
(S.authenticate s ~username:"alice" ~password:"heavyduty1")));
164
164
ignore trainee) );
165
165
( "finishing is atomic: the record is saved and the slot cleared",
166
166
`Quick,
@@ -172,7 +172,7 @@
172
172
let repo = connect uri in
173
173
let s = S.make ~repo in
174
174
let t =
175
Removed:
(ok (run (S.register s ~email:"a@b.com" ~password:"heavyduty1")))
175
Added:
(ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
176
176
.Trainee.id
177
177
in
178
178
let _ =
test/test_web.ml
@@ -110,14 +110,14 @@
110
110
let stop = String.index_from html start '"' in
111
111
Some (String.sub html start (stop - start)))
112
112
113
Removed:
let register client ~email ~password =
113
Added:
let register client ~username ~password =
114
114
let page = body (get client "/register") in
115
115
let token = Option.get (csrf_token page) in
116
116
post client "/register"
117
Removed:
[ ("dream.csrf", token); ("email", email); ("password", password) ]
117
Added:
[("dream.csrf", token); ("username", username); ("password", password)]
118
118
119
119
let sign_in_new client =
120
Removed:
register client ~email:"lifter@example.com" ~password:"heavyduty1"
120
Added:
register client ~username:"lifter" ~password:"heavyduty1"
121
121
122
122
let route_tests =
123
123
[
@@ -153,8 +153,16 @@
153
153
"shows the routine catalog" true
154
154
(contains ~substring:"Routines" (body overview));
155
155
Alcotest.(check bool)
156
Removed:
"shows the signed-in email" true
157
Removed:
(contains ~substring:"lifter@example.com" (body overview)) );
156
Added:
"shows the signed-in username" true
157
Added:
(contains ~substring:"lifter" (body overview)) );
158
Added:
( "the sign-in page renders a username field",
159
Added:
`Quick,
160
Added:
fun () ->
161
Added:
let c = client () in
162
Added:
let page = body (get c "/login") in
163
Added:
Alcotest.(check bool)
164
Added:
"has a username field" true
165
Added:
(contains ~substring:"name=\"username\"" page) );
158
166
( "a form post without a CSRF token is refused",
159
167
`Quick,
160
168
fun () ->