[OCaml] High Intensity Training Online
feat add default development test user
Make local development immediately usable with representative Ideal Routine history. Keep deployment seeding opt-in and preserve existing native history.
Changed files
ARCHITECTURE.org
@@ -365,7 +365,11 @@
365
365
Passwords carry no length or content policy, so they never refuse registration.
366
366
Public sign-up is closed by default: =Handlers.make ?registration_open=
367
367
defaults to =false=, which removes the =/register= routes and hides the link.
368
Removed:
=bin/main.ml= seeds one account idempotently from =HITO_SEED_PASSWORD=.
368
Added:
=bin/main.ml= seeds the development account =test= with password =test= when
369
Added:
=HITO_VERSION= is =development=. The development seed selects the Ideal Routine
370
Added:
and creates 39 complete native workouts over 90 days. A deployment defaults to
371
Added:
no seed. An explicit deployment seed still uses =HITO_SEED_PASSWORD= and
372
Added:
=HITO_SEED_CSV=.
369
373
370
374
A session holds the trainee id in a signed cookie. Every application route
371
375
resolves it through one =authenticated= combinator that passes the trainee to a
@@ -580,17 +584,23 @@
580
584
dune build && ./_build/default/bin/main.exe # http://localhost:8080/
581
585
#+end_src
582
586
583
Removed:
=bin/main.ml= opens the store, applies migrations, runs =Seed.single_user= for
584
Removed:
the one pre-seeded account, and starts Dream. The seed lives in =bin/seed.ml=,
585
Removed:
beside the root rather than in a library: it names a concrete adapter and is
586
Removed:
temporary until public registration returns. The socket binds *loopback only*.
587
Added:
=bin/main.ml= opens the store, applies migrations, and runs the seed selected by
588
Added:
its environment. In development, =Seed.development_user= creates the local
589
Added:
=test= account with password =test= and native history. In a deployment, the
590
Added:
optional =Seed.single_user= path imports the configured Hevy export. The seed
591
Added:
adapter lives in =bin/seed.ml=. The reusable development fixture lives in
592
Added:
=hito.app=, so the test suite checks the same repository path. The socket binds
593
Added:
*loopback only*.
587
594
588
Removed:
| Variable | Purpose | Default |
589
Removed:
|----------------------+---------------------------------------+-------------------------|
590
Removed:
| =HITO_DB= | Caqti database URI | =sqlite3:hito.sqlite= |
591
Removed:
| =HITO_SECRET= | Signs session cookies and CSRF tokens | random per run |
592
Removed:
| =HITO_PORT= | TCP port | =8080= |
593
Removed:
| =HITO_SEED_PASSWORD= | Password for the seeded account | none — refuses to start |
595
Added:
| Variable | Purpose | Default |
596
Added:
|----------------------+------------------------------------------+-------------------------|
597
Added:
| =HITO_DB= | Caqti database URI | =sqlite3:hito.sqlite= |
598
Added:
| =HITO_SECRET= | Signs session cookies and CSRF tokens | random per run |
599
Added:
| =HITO_PORT= | TCP port | =8080= |
600
Added:
| =HITO_VERSION= | Deployment identifier | =development= |
601
Added:
| =HITO_SEED= | Enable or disable startup seeding | =1= in development, =0= otherwise |
602
Added:
| =HITO_SEED_PASSWORD= | Password for an explicit deployment seed | none — refuses to start |
603
Added:
| =HITO_SEED_CSV= | Hevy export for an explicit deployment seed | =workout_data.csv= |
594
604
595
605
Set =HITO_SECRET= in production. When it is unset, sessions do not survive a
596
606
restart.
README.org
@@ -47,13 +47,19 @@
47
47
| ~HITO_SECRET~ | Signs sessions and CSRF tokens. Set it in production. |
48
48
| ~HITO_PORT~ | The TCP port. Default: ~8080~. The server binds loopback. |
49
49
| ~HITO_VERSION~ | The deployment identifier in the footer. |
50
Removed:
| ~HITO_SEED~ | ~1~ seeds one account at startup. Default: ~0~. |
51
Removed:
| ~HITO_SEED_PASSWORD~ | Necessary when ~HITO_SEED=1~. |
52
Removed:
| ~HITO_SEED_CSV~ | The Hevy export to import for the seeded account. |
50
Added:
| ~HITO_SEED~ | ~1~ seeds an account at startup. Development defaults to ~1~. Deployment defaults to ~0~. |
51
Added:
| ~HITO_SEED_PASSWORD~ | Password for the deployment seed when ~HITO_SEED=1~. |
52
Added:
| ~HITO_SEED_CSV~ | The Hevy export for the deployment seed. |
53
53
54
54
Sessions are in a signed cookie. The server sets a same-origin content security
55
55
policy and refuses framing. Put a proxy that terminates TLS in front of the
56
56
server.
57
Added:
58
Added:
When the version is ~development~, startup creates the local account ~test~ with
59
Added:
password ~test~. It selects the Ideal Routine and adds 39 complete native
60
Added:
workouts across the past 90 days. Set ~HITO_SEED=0~ to disable this fixture.
61
Added:
Deployments default to no seed. An explicit deployment seed still uses
62
Added:
~HITO_SEED_PASSWORD~ and ~HITO_SEED_CSV~.
57
63
58
64
* Develop
59
65
bin/main.ml
@@ -12,22 +12,22 @@
12
12
- HITO_PORT TCP port. Default: 8080
13
13
- HITO_VERSION Deployment commit identifier shown in the page footer. Defaults
14
14
to "development" outside a deployment.
15
Removed:
- HITO_SEED Set to 1 to seed the single [blendux] account on startup.
16
Removed:
Default: 0, no seeding. Temporary, until public registration
17
Removed:
returns.
18
Removed:
- HITO_SEED_PASSWORD Password for the seeded account. Required when
19
Removed:
HITO_SEED=1; ignored otherwise.
20
Removed:
- HITO_SEED_CSV Path to the Hevy export imported as the seeded account's
21
Removed:
history. Default: workout_data.csv. Read only when HITO_SEED=1,
22
Removed:
and imported once, when the account has no promoted records.
15
Added:
- HITO_SEED Set to 1 to seed an account on startup. In development,
16
Added:
the default is 1 and the account is [test] with password
17
Added:
[test]. In a deployment, the default is 0.
18
Added:
- HITO_SEED_PASSWORD Password for the deployed seeded account. Required
19
Added:
when [HITO_SEED=1] outside development.
20
Added:
- HITO_SEED_CSV Path to the Hevy export imported as the deployed seeded
21
Added:
account's history. Default: workout_data.csv. Read only when
22
Added:
[HITO_SEED=1] outside development.
23
23
24
24
The socket binds loopback only. Authentication is local username and
25
25
password. Sessions and CSRF tokens are signed with the secret.
26
26
27
27
Public sign-up is closed: [Handlers.make] leaves [registration_open] at its
28
Removed:
[false] default. When HITO_SEED=1, a single account ([blendux]) is seeded
29
Removed:
on startup with the password from [HITO_SEED_PASSWORD]. Both are temporary
30
Removed:
until public registration returns. *)
28
Added:
[false] default. In development, the default seed creates [test] with
29
Added:
password [test] and three months of native history. A deployment can opt in
30
Added:
to the [blendux] import seed with [HITO_SEED=1]. *)
31
31
32
32
module Handlers =
33
33
Hito_web.Handlers.Make
@@ -58,6 +58,10 @@
58
58
let () =
59
59
let db_uri = getenv "HITO_DB" "sqlite3:local_db/hito.sqlite" in
60
60
let port = port_of_env () in
61
Added:
let version = getenv "HITO_VERSION" "development" in
62
Added:
let seed_mode =
63
Added:
getenv "HITO_SEED" (if version = "development" then "1" else "0")
64
Added:
in
61
65
let secret =
62
66
match Sys.getenv_opt "HITO_SECRET" with
63
67
| Some s when s <> "" -> s
@@ -73,12 +77,12 @@
73
77
(Caqti_error.show error);
74
78
exit 1
75
79
| Ok repo ->
76
Removed:
(* Seeding a single account is an explicit opt-in. Without HITO_SEED=1
77
Removed:
the server starts with whatever accounts the database holds and never
78
Removed:
demands a seed password, so a deployment that has moved past the seed
79
Removed:
carries no dead requirement. *)
80
Removed:
(match getenv "HITO_SEED" "0" with
81
Removed:
| "1" ->
80
Added:
(* Development seeds are automatic unless HITO_SEED=0 disables them.
81
Added:
Deployments default to no seed because HITO_VERSION carries the commit
82
Added:
identifier. The deployment seed still requires an explicit password. *)
83
Added:
(match (version, seed_mode) with
84
Added:
| "development", "1" -> Lwt_main.run (Seed.development_user repo)
85
Added:
| _, "1" ->
82
86
let seed_password =
83
87
match Sys.getenv_opt "HITO_SEED_PASSWORD" with
84
88
| Some p when p <> "" -> p
@@ -90,8 +94,8 @@
90
94
let seed_csv = getenv "HITO_SEED_CSV" "workout_data.csv" in
91
95
Lwt_main.run
92
96
(Seed.single_user repo ~password:seed_password ~csv_path:seed_csv)
93
Removed:
| "0" -> ()
94
Removed:
| other -> fail_config "HITO_SEED must be 0 or 1, got %S" other);
97
Added:
| _, "0" -> ()
98
Added:
| _, other -> fail_config "HITO_SEED must be 0 or 1, got %S" other);
95
99
let handlers = Handlers.make ~repo () in
96
100
(* Sessions live in a signed, encrypted cookie, not in SQLite. The
97
101
repository already holds the one connection pool for this file; a
bin/seed.ml
@@ -7,6 +7,11 @@
7
7
(Hito_persistence.Sqlite_repo)
8
8
(Hito_persistence.Bcrypt_hash)
9
9
10
Added:
module Development_seed =
11
Added:
Hito_app.Development_seed.Make
12
Added:
(Hito_persistence.Sqlite_repo)
13
Added:
(Hito_persistence.Bcrypt_hash)
14
Added:
10
15
(* The trainee's real Hevy export, imported as personal history through the
11
16
Workout_import use case rather than fabricated. The use case gates what the
12
17
core ever sees: only a set whose source exercise maps to the curated catalog
@@ -174,3 +179,9 @@
174
179
Format.eprintf "hito: cannot seed user: %a@."
175
180
Hito_app.Trainee.pp_username_error e;
176
181
exit 1
182
Added:
183
Added:
let development_user repo =
184
Added:
let now =
185
Added:
Recovery.timestamp_of_unix_seconds (int_of_float (Unix.gettimeofday ()))
186
Added:
in
187
Added:
Development_seed.seed repo ~now
bin/seed.mli
@@ -15,3 +15,8 @@
15
15
blocks a workout. When no file exists at [csv_path] the import is skipped,
16
16
so a deployment that ships no export still seeds the account and routine.
17
17
Exits the process on a malformed seed username or an import failure. *)
18
Added:
19
Added:
val development_user : Hito_persistence.Sqlite_repo.t -> unit Lwt.t
20
Added:
(** Seed the local development account [test] with password [test], the Ideal
21
Added:
Routine, and three months of native workout history. Existing native history
22
Added:
is left unchanged. *)
lib/app/development_seed.ml
@@ -0,0 +1,143 @@
1
Added:
(** Deterministic native history for the local development account.
2
Added:
3
Added:
The fixture uses the application repository port, so it exercises the same
4
Added:
stored-workout path as a real trainee. It does not belong in production. *)
5
Added:
6
Added:
open Lwt.Infix
7
Added:
8
Added:
module Make (R : Repository.S) (H : Password_hash.S) = struct
9
Added:
module App_service = Service.Make (R) (H)
10
Added:
module Stimulus = Evidence.Stimulus
11
Added:
12
Added:
let day = 86_400
13
Added:
let fixture_days = 90
14
Added:
let cycle_days = 7
15
Added:
let session_offsets = [ 0; 2; 4 ]
16
Added:
17
Added:
let load_for exercise =
18
Added:
match (Exercise.id exercise :> string) with
19
Added:
| "dumbbell-flyes" -> 18.
20
Added:
| "incline-press" -> 55.
21
Added:
| "laterals" -> 10.
22
Added:
| "bent-over-laterals" -> 8.
23
Added:
| "lying-french-press" -> 25.
24
Added:
| "dips" -> 0.
25
Added:
| "pullovers" -> 20.
26
Added:
| "close-grip-pulldowns" -> 50.
27
Added:
| "bent-over-rows" -> 50.
28
Added:
| "shrugs" -> 60.
29
Added:
| "hyperextensions" -> 0.
30
Added:
| "curls" -> 30.
31
Added:
| "preacher-curls" -> 25.
32
Added:
| "leg-extensions" -> 40.
33
Added:
| "leg-presses" -> 120.
34
Added:
| "squats" -> 70.
35
Added:
| "leg-curls" -> 35.
36
Added:
| "calf-raises" -> 60.
37
Added:
| "sit-ups" -> 0.
38
Added:
| "straight-arm-pulldowns" -> 35.
39
Added:
| "reverse-pec-deck" -> 30.
40
Added:
| "pressdowns" -> 30.
41
Added:
| "triceps-machine" -> 35.
42
Added:
| "deadlifts" -> 90.
43
Added:
| _ -> 10.
44
Added:
45
Added:
let effort ~cycle exercise =
46
Added:
let load = load_for exercise in
47
Added:
let load = if Float.equal load 0. then 0. else load +. float_of_int cycle in
48
Added:
let reps = 6 + (cycle mod 5) in
49
Added:
match
50
Added:
Stimulus.Effort.make ~exercise ~load ~reps
51
Added:
~outcome:Stimulus.Positive_failure
52
Added:
with
53
Added:
| Ok effort -> effort
54
Added:
| Error error ->
55
Added:
invalid_arg
56
Added:
(Format.asprintf "invalid development fixture effort: %a"
57
Added:
Stimulus.Effort.pp_error error)
58
Added:
59
Added:
let stimulus ~cycle prescription =
60
Added:
let single exercise =
61
Added:
Stimulus.make (Stimulus.Single (effort ~cycle exercise))
62
Added:
in
63
Added:
match Prescription.Stimulus.delivery prescription with
64
Added:
| Prescription.Stimulus.Single exercise -> single exercise
65
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
66
Added:
Stimulus.make
67
Added:
(Stimulus.Pair
68
Added:
{
69
Added:
first = effort ~cycle isolation;
70
Added:
second = effort ~cycle compound;
71
Added:
})
72
Added:
73
Added:
let complete_workout ~cycle ~started_at prescription =
74
Added:
let clearance = Option.get (Recovery.clear Recovery.Ready) in
75
Added:
let workout = Evidence.Workout.start prescription ~clearance ~started_at in
76
Added:
let workout =
77
Added:
Prescription.Workout.stimuli prescription
78
Added:
|> List.mapi (fun slot prescription -> (slot, prescription))
79
Added:
|> List.fold_left
80
Added:
(fun workout (slot, prescription) ->
81
Added:
Evidence.Workout.record_at workout ~slot
82
Added:
(stimulus ~cycle prescription))
83
Added:
workout
84
Added:
in
85
Added:
Evidence.Workout.finish workout
86
Added:
~ended_at:
87
Added:
(Recovery.timestamp_to_unix_seconds started_at + (45 * 60)
88
Added:
|> Recovery.timestamp_of_unix_seconds)
89
Added:
90
Added:
let seed_history repo trainee_id ~now routine =
91
Added:
let first =
92
Added:
Recovery.timestamp_to_unix_seconds now - (fixture_days * day)
93
Added:
|> Recovery.timestamp_of_unix_seconds
94
Added:
in
95
Added:
let sessions =
96
Added:
List.init 13 (fun cycle ->
97
Added:
List.map
98
Added:
(fun offset -> (cycle, (cycle * cycle_days) + offset, offset / 2))
99
Added:
session_offsets)
100
Added:
|> List.concat
101
Added:
in
102
Added:
Lwt_list.iter_s
103
Added:
(fun (cycle, offset_days, workout_index) ->
104
Added:
let started_at =
105
Added:
Recovery.timestamp_to_unix_seconds first + (offset_days * day)
106
Added:
|> Recovery.timestamp_of_unix_seconds
107
Added:
in
108
Added:
let prescription =
109
Added:
List.nth (Prescription.Routine.workouts routine) workout_index
110
Added:
in
111
Added:
let workout = complete_workout ~cycle ~started_at prescription in
112
Added:
R.finish_workout repo trainee_id workout >|= ignore)
113
Added:
sessions
114
Added:
115
Added:
let find_or_register service repo =
116
Added:
App_service.register service ~username:"test" ~password:"test" >>= function
117
Added:
| Ok trainee -> Lwt.return_some trainee
118
Added:
| Error App_service.Username_taken -> (
119
Added:
match Trainee.username "test" with
120
Added:
| Error _ -> Lwt.return_none
121
Added:
| Ok username -> R.find_trainee_by_username repo username)
122
Added:
| Error (App_service.Username_invalid error) ->
123
Added:
Lwt.fail_with
124
Added:
(Format.asprintf "cannot seed development user: %a"
125
Added:
Trainee.pp_username_error error)
126
Added:
127
Added:
let seed repo ~now =
128
Added:
let service = App_service.make ~repo in
129
Added:
find_or_register service repo >>= function
130
Added:
| None -> Lwt.return_unit
131
Added:
| Some trainee -> (
132
Added:
let trainee_id = trainee.Trainee.id in
133
Added:
R.set_active_routine repo trainee_id (Repository.routine_id "ideal")
134
Added:
>>= fun () ->
135
Added:
R.history repo trainee_id >>= function
136
Added:
| _ :: _ -> Lwt.return_unit
137
Added:
| [] -> (
138
Added:
match R.find_routine repo (Repository.routine_id "ideal") with
139
Added:
| None ->
140
Added:
Lwt.fail_with
141
Added:
"cannot seed development user: Ideal Routine missing"
142
Added:
| Some routine -> seed_history repo trainee_id ~now routine))
143
Added:
end
lib/app/development_seed.mli
@@ -0,0 +1,8 @@
1
Added:
(** Deterministic native history for the local development account. *)
2
Added:
3
Added:
module Make (R : Repository.S) (_ : Password_hash.S) : sig
4
Added:
val seed : R.t -> now:Recovery.timestamp -> unit Lwt.t
5
Added:
(** Create [test] with password [test], select the Ideal Routine, and add
6
Added:
three months of complete history when the account has no native history.
7
Added:
Existing history is left unchanged. *)
8
Added:
end
test/test_development_seed.ml
@@ -0,0 +1,72 @@
1
Added:
(** Tests for the automatic development account fixture. *)
2
Added:
3
Added:
open Hito_app
4
Added:
module Seed = Development_seed.Make (Test_repo) (Test_hash)
5
Added:
module Service = Service.Make (Test_repo) (Test_hash)
6
Added:
module Workout = Evidence.Workout
7
Added:
8
Added:
let run = Lwt_main.run
9
Added:
let day = 86_400
10
Added:
let now = Recovery.timestamp_of_unix_seconds (100 * day)
11
Added:
12
Added:
let development_seed_tests =
13
Added:
[
14
Added:
( "creates test with three months of native Ideal Routine history",
15
Added:
`Quick,
16
Added:
fun () ->
17
Added:
let repo = Test_repo.create () in
18
Added:
run (Seed.seed repo ~now);
19
Added:
let service = Service.make ~repo in
20
Added:
let trainee =
21
Added:
match
22
Added:
run (Service.authenticate service ~username:"test" ~password:"test")
23
Added:
with
24
Added:
| Some trainee -> trainee
25
Added:
| None -> Alcotest.fail "expected the development account"
26
Added:
in
27
Added:
let history = run (Test_repo.history repo trainee.Trainee.id) in
28
Added:
Alcotest.(check int) "thirteen weekly cycles" 39 (List.length history);
29
Added:
Alcotest.(check bool)
30
Added:
"all workouts are complete" true
31
Added:
(List.for_all
32
Added:
(fun record -> Workout.is_finished record.Repository.workout)
33
Added:
history);
34
Added:
let oldest = List.hd (List.rev history) in
35
Added:
let newest = List.hd history in
36
Added:
Alcotest.(check int)
37
Added:
"oldest workout starts ninety days ago"
38
Added:
((100 * day) - (90 * day))
39
Added:
(Recovery.timestamp_to_unix_seconds
40
Added:
(Workout.started_at oldest.Repository.workout));
41
Added:
Alcotest.(check int)
42
Added:
"newest workout starts two days ago"
43
Added:
((100 * day) - (2 * day))
44
Added:
(Recovery.timestamp_to_unix_seconds
45
Added:
(Workout.started_at newest.Repository.workout));
46
Added:
match run (Service.active_routine service trainee.Trainee.id) with
47
Added:
| Some (_, routine) ->
48
Added:
Alcotest.(check string)
49
Added:
"Ideal Routine is active" "Ideal Routine"
50
Added:
(Prescription.Routine.name routine)
51
Added:
| None -> Alcotest.fail "expected an active routine" );
52
Added:
( "does not duplicate existing development history",
53
Added:
`Quick,
54
Added:
fun () ->
55
Added:
let repo = Test_repo.create () in
56
Added:
run (Seed.seed repo ~now);
57
Added:
run (Seed.seed repo ~now);
58
Added:
let trainee =
59
Added:
match
60
Added:
run
61
Added:
(Test_repo.find_trainee_by_username repo
62
Added:
(Result.get_ok (Trainee.username "test")))
63
Added:
with
64
Added:
| Some trainee -> trainee
65
Added:
| None -> Alcotest.fail "expected the development account"
66
Added:
in
67
Added:
Alcotest.(check int)
68
Added:
"history remains one fixture" 39
69
Added:
(List.length (run (Test_repo.history repo trainee.Trainee.id))) );
70
Added:
]
71
Added:
72
Added:
let suite = [ ("development seed", development_seed_tests) ]
test/test_hito.ml
@@ -11,8 +11,8 @@
11
11
@ Test_evidence.suite @ Test_progression.suite @ Test_service.suite
12
12
@ Test_workout_import.suite @ Test_import_service.suite @ Test_codec.suite
13
13
@ Test_import_codec.suite @ Test_import_repo.suite @ Test_import_sqlite.suite
14
Removed:
@ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite @ Test_decode.suite
15
Removed:
@ Test_hevy_csv.suite @ Web.Auth.suite @ Web.Overview.suite
16
Removed:
@ Web.Workout.suite @ Web.Logbook.suite @ Web.App_feedback.suite
17
Removed:
@ Web.Profile.suite @ Web.Import.suite @ Web.Errors.suite
18
Removed:
@ Web.Isolation.suite)
14
Added:
@ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite
15
Added:
@ Test_development_seed.suite @ Test_decode.suite @ Test_hevy_csv.suite
16
Added:
@ Web.Auth.suite @ Web.Overview.suite @ Web.Workout.suite @ Web.Logbook.suite
17
Added:
@ Web.App_feedback.suite @ Web.Profile.suite @ Web.Import.suite
18
Added:
@ Web.Errors.suite @ Web.Isolation.suite)