[OCaml] High Intensity Training Online

feat close public registration to a single seeded user

Public sign-up is not ready, so gate it off and run on one account until it returns. Handlers.make takes ?registration_open (default false): when unset the /register routes are absent and the sign-in page hides its Register link. bin/main.ml seeds the blendux account on startup, idempotently, with the password from HITO_SEED_PASSWORD; the server refuses to start when that is unset rather than fall back to a weak default. Reopening sign-up is a one-argument change plus dropping the seed. The web test harness opens registration so the auth-flow tests still create trainees via /register, with a new test asserting the closed default 404s /register and omits the Register link.

Commit
d1f80a98cb896bf5a72b9f0f36927a2f193541dd
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
ARCHITECTURE.md
index 767a18d8..b9f44851 100644..100644
@@ -95,6 +95,12 @@
95 95 characters. A credential carries a bcrypt hash, never the password, and the
96 96 hash is computed and checked inside this module through `safepass`. Passwords
97 97 carry no length or content policy.
98 Added: - **Registration posture** — public sign-up is closed for now. `Handlers.make`
99 Added: takes `?registration_open` (default `false`): when unset the `/register`
100 Added: routes are absent and the sign-in page hides its Register link. `bin/main.ml`
101 Added: seeds a single account (`blendux`) on startup, idempotently, with the password
102 Added: from `HITO_SEED_PASSWORD` (required; the server refuses to start without it).
103 Added: Reopening sign-up is a one-argument change plus removing the seed.
98 104 - **Repository port** — trainee-scoped account, catalog, selection,
99 105 in-progress, and history operations, plus a transactional `finish_workout`
100 106 that saves a finished workout and clears the in-progress slot as one unit.
@@ -243,7 +249,7 @@
243 249
244 250 | Route | Method | Purpose |
245 251 |----------------------------|-----------|-------------------------------------------------------|
246 Removed: | `/register` | GET, POST | Create an account and sign in |
252 Added: | `/register` | GET, POST | Create an account and sign in (disabled by default) |
247 253 | `/login` | GET, POST | Sign in |
248 254 | `/logout` | POST | Sign out |
249 255 | `/routines` | GET | Choose a routine |
bin/main.ml
index 8e07c700..c4583eae 100644..100644
@@ -8,15 +8,39 @@
8 8 unset, a random secret is generated for this run only, so
9 9 sessions do not survive a restart. Set it in production.
10 10 - HITO_PORT TCP port. Default: 8080
11 Added: - HITO_SEED_PASSWORD Password for the seeded [blendux] account. Required;
12 Added: the server refuses to start when unset. Temporary, until
13 Added: public registration returns.
11 14
12 15 The socket binds loopback only. Authentication is local username and
13 Removed: password; sessions and CSRF tokens are signed with the secret. *)
16 Added: password; sessions and CSRF tokens are signed with the secret.
14 17
18 Added: Public sign-up is closed: [Handlers.make] leaves [registration_open] at its
19 Added: [false] default, and a single account ([blendux]) is seeded on startup with
20 Added: the password from [HITO_SEED_PASSWORD]. Both are temporary until public
21 Added: registration returns. *)
22 Added:
15 23 module Handlers = Hito_web.Handlers.Make (Hito_app.Sqlite_repo)
24 Added: module Service = Hito_app.Service.Make (Hito_app.Sqlite_repo)
16 25
17 26 let getenv name default =
18 27 match Sys.getenv_opt name with Some v when v <> "" -> v | _ -> default
19 28
29 Added: (* Public sign-up is closed for now, so the deployment runs on a single
30 Added: pre-seeded account. The password comes from the environment, never a
31 Added: hardcoded default. Seeding is idempotent: a username already present is a
32 Added: success, not an error — so rotating the password means updating the store,
33 Added: not re-running this. Remove this once public registration returns. *)
34 Added: let seed_single_user repo ~password =
35 Added: let service = Service.make ~repo in
36 Added: Service.register service ~username:"blendux" ~password
37 Added: |> Lwt.map (function
38 Added: | Ok _ | Error `Username_taken -> ()
39 Added: | Error (`Username e) ->
40 Added: Format.eprintf "hito: cannot seed user: %a@."
41 Added: Hito_app.Trainee.pp_username_error e;
42 Added: exit 1)
43 Added:
20 44 let () =
21 45 let db_uri = getenv "HITO_DB" "sqlite3:hito.sqlite" in
22 46 let port = int_of_string (getenv "HITO_PORT" "8080") in
@@ -35,6 +59,16 @@
35 59 (Caqti_error.show error);
36 60 exit 1
37 61 | Ok repo ->
62 Added: let seed_password =
63 Added: match Sys.getenv_opt "HITO_SEED_PASSWORD" with
64 Added: | Some p when p <> "" -> p
65 Added: | _ ->
66 Added: prerr_endline
67 Added: "hito: HITO_SEED_PASSWORD is not set; refusing to seed the \
68 Added: account with a default. Set it and restart.";
69 Added: exit 1
70 Added: in
71 Added: Lwt_main.run (seed_single_user repo ~password:seed_password);
38 72 let handlers = Handlers.make ~repo () in
39 73 Dream.run ~interface:"localhost" ~port
40 74 @@ Dream.logger @@ Dream.set_secret secret @@ Dream.sql_pool db_uri
lib/web/handlers.ml
index 17ac9257..bbf0b509 100644..100644
@@ -4,12 +4,18 @@
4 4 module Make (R : Repository.S) = struct
5 5 module Service = Service.Make (R)
6 6
7 Removed: type t = { service : Service.t; now : unit -> Recovery.timestamp }
7 Added: type t = {
8 Added: service : Service.t;
9 Added: now : unit -> Recovery.timestamp;
10 Added: registration_open : bool;
11 Added: }
8 12
9 13 let default_now () =
10 14 Recovery.timestamp_of_unix_seconds (int_of_float (Unix.gettimeofday ()))
11 15
12 Removed: let make ~repo ?(now = default_now) () = { service = Service.make ~repo; now }
16 Added: let make ~repo ?(now = default_now) ?(registration_open = false) () =
17 Added: { service = Service.make ~repo; now; registration_open }
18 Added:
13 19 let html ?status page = Dream_html.respond ?status page
14 20 let redirect request path = Dream_html.redirect request path
15 21
@@ -97,7 +103,8 @@
97 103 let login_page t request =
98 104 current_trainee t request >>= function
99 105 | Some _ -> redirect_to request Routes.home
100 Removed: | None -> html (Pages.login request ())
106 Added: | None ->
107 Added: html (Pages.login request ~registration_open:t.registration_open ())
101 108
102 109 let register_page t request =
103 110 current_trainee t request >>= function
@@ -141,13 +148,22 @@
141 148 redirect_to request Routes.login
142 149
143 150 let routes t =
151 Added: (* Public sign-up is disabled by default; the [/register] routes appear
152 Added: only when [registration_open] is set. Everything else is unconditional. *)
153 Added: let register_routes =
154 Added: if t.registration_open then
155 Added: [
156 Added: Dream_html.get Routes.register (register_page t);
157 Added: Dream_html.post Routes.register (register t);
158 Added: ]
159 Added: else []
160 Added: in
144 161 [
145 162 Dream_html.get Routes.login (login_page t);
146 163 Dream_html.post Routes.login (login t);
147 Removed: Dream_html.get Routes.register (register_page t);
148 Removed: Dream_html.post Routes.register (register t);
149 164 Dream_html.post Routes.logout (logout t);
150 165 ]
166 Added: @ register_routes
151 167 end
152 168
153 169 (* --- helpers over the service --- *)
lib/web/handlers.mli
index d078c0b7..2bcbf298 100644..100644
@@ -5,7 +5,15 @@
5 5 module Make (R : Hito_app.Repository.S) : sig
6 6 type t
7 7
8 Removed: val make : repo:R.t -> ?now:(unit -> Recovery.timestamp) -> unit -> t
8 Added: val make :
9 Added: repo:R.t ->
10 Added: ?now:(unit -> Recovery.timestamp) ->
11 Added: ?registration_open:bool ->
12 Added: unit ->
13 Added: t
14 Added: (** [registration_open] exposes the public [/register] routes and the sign-in
15 Added: page's Register link. Defaults to [false]: the deployment runs on
16 Added: pre-seeded accounts until public sign-up returns. *)
9 17
10 18 val routes : t -> Dream.route list
11 19 (** The route table. Session and CSRF middleware are applied per handler; wrap
lib/web/pages.ml
index d779aac8..2099b608 100644..100644
@@ -202,18 +202,24 @@
202 202 void "input" [ type_ "submit"; value submit ];
203 203 ]
204 204
205 Removed: let login request ?error () =
205 Added: let login request ?error ?(registration_open = false) () =
206 Added: let register_prompt =
207 Added: if registration_open then
208 Added: [
209 Added: tag "p" []
210 Added: [
211 Added: txt "No account yet? ";
212 Added: tag "a" [ href Routes.register ] [ txt "Register" ];
213 Added: ];
214 Added: ]
215 Added: else []
216 Added: in
206 217 html_page ~active:"auth" "Sign in"
207 218 ([
208 219 tag "h2" [] [ txt "Sign in" ];
209 220 credentials_form request ~submit:"Sign in" ~action_path:Routes.login;
210 Removed: tag "p" []
211 Removed: [
212 Removed: txt "No account yet? ";
213 Removed: tag "a" [ href Routes.register ] [ txt "Register" ];
214 Removed: ];
215 221 ]
216 Removed: @ auth_error error)
222 Added: @ register_prompt @ auth_error error)
217 223
218 224 let register request ?error () =
219 225 html_page ~active:"auth" "Register"
lib/web/pages.mli
index 69764c77..f3bd1b29 100644..100644
@@ -2,7 +2,10 @@
2 2
3 3 type page = Dream_html.node
4 4
5 Removed: val login : Dream.request -> ?error:string -> unit -> page
5 Added: val login :
6 Added: Dream.request -> ?error:string -> ?registration_open:bool -> unit -> page
7 Added: (** [registration_open] shows the "Register" link. Defaults to [false]. *)
8 Added:
6 9 val register : Dream.request -> ?error:string -> unit -> page
7 10
8 11 val choose_routine :
test/test_web.ml
index 92d224be..cfb1d86a 100644..100644
@@ -6,9 +6,13 @@
6 6 open Hito_app
7 7 module Handlers = Hito_web.Handlers.Make (Memory_repo)
8 8
9 Removed: (* A fresh, fully wired application: secret, in-memory sessions, routes. *)
9 Added: (* A fresh, fully wired application: secret, in-memory sessions, routes.
10 Added: Registration is opened here so the auth-flow tests can create trainees via
11 Added: [/register]; production keeps it closed. *)
10 12 let app () =
11 Removed: let handlers = Handlers.make ~repo:(Memory_repo.create ()) () in
13 Added: let handlers =
14 Added: Handlers.make ~repo:(Memory_repo.create ()) ~registration_open:true ()
15 Added: in
12 16 Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
13 17 |> fun handler -> Dream.set_secret "test-secret-value" handler
14 18
@@ -299,6 +303,25 @@
299 303 Alcotest.(check int)
300 304 "authenticated overview" 200
301 305 (status (get c "/")) );
306 Added: ( "with registration closed the routes are gone and the link is hidden",
307 Added: `Quick,
308 Added: fun () ->
309 Added: (* The production default: [registration_open] unset. The
310 Added: [/register] routes are absent (404) and the sign-in page omits
311 Added: the Register link. *)
312 Added: let handlers = Handlers.make ~repo:(Memory_repo.create ()) () in
313 Added: let app =
314 Added: Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
315 Added: |> fun h -> Dream.set_secret "test-secret-value" h
316 Added: in
317 Added: let c = { app; jar = [] } in
318 Added: Alcotest.(check int)
319 Added: "GET /register is not found" 404
320 Added: (status (get c "/register"));
321 Added: let login = body (get c "/login") in
322 Added: Alcotest.(check bool)
323 Added: "no Register link on sign-in" false
324 Added: (contains ~substring:"href=\"/register\"" login) );
302 325 ] );
303 326 ( "web.flow",
304 327 [