1 (* The production server. State is durable: trainees, their active routine, 2 the workout in progress, and history all live in SQLite. There is no 3 server-wide in-memory state. 4 5 Configuration comes from the environment: 6 - HITO_DB Caqti database URI. Default: sqlite3:hito.sqlite 7 - HITO_SECRET Secret for signing session cookies and CSRF tokens. When 8 unset, a random secret is generated for this run only, so 9 sessions do not survive a restart. Set it in production. 10 - HITO_PORT TCP port. Default: 8080 11 - HITO_SEED_PASSWORD Password for the seeded [blendux] account. Required; 12 the server refuses to start when unset. Temporary, until 13 public registration returns. 14 15 The socket binds loopback only. Authentication is local username and 16 password; sessions and CSRF tokens are signed with the secret. 17 18 Public sign-up is closed: [Handlers.make] leaves [registration_open] at its 19 [false] default, and a single account ([blendux]) is seeded on startup with 20 the password from [HITO_SEED_PASSWORD]. Both are temporary until public 21 registration returns. *) 22 23 module Handlers = Hito_web.Handlers.Make (Hito_app.Sqlite_repo) 24 module Service = Hito_app.Service.Make (Hito_app.Sqlite_repo) 25 26 let getenv name default = 27 match Sys.getenv_opt name with Some v when v <> "" -> v | _ -> default 28 29 (* Public sign-up is closed for now, so the deployment runs on a single 30 pre-seeded account. The password comes from the environment, never a 31 hardcoded default. Seeding is idempotent: a username already present is a 32 success, not an error — so rotating the password means updating the store, 33 not re-running this. Remove this once public registration returns. *) 34 let seed_single_user repo ~password = 35 let service = Service.make ~repo in 36 Service.register service ~username:"blendux" ~password 37 |> Lwt.map (function 38 | Ok _ | Error `Username_taken -> () 39 | Error (`Username e) -> 40 Format.eprintf "hito: cannot seed user: %a@." 41 Hito_app.Trainee.pp_username_error e; 42 exit 1) 43 44 let () = 45 let db_uri = getenv "HITO_DB" "sqlite3:hito.sqlite" in 46 let port = int_of_string (getenv "HITO_PORT" "8080") in 47 let secret = 48 match Sys.getenv_opt "HITO_SECRET" with 49 | Some s when s <> "" -> s 50 | _ -> 51 prerr_endline 52 "hito: HITO_SECRET is not set; using a random secret. Sessions will \ 53 not survive a restart."; 54 Dream.to_base64url (Dream.random 32) 55 in 56 match Lwt_main.run (Hito_app.Sqlite_repo.connect db_uri) with 57 | Error error -> 58 Printf.eprintf "hito: cannot open database %S: %s\n" db_uri 59 (Caqti_error.show error); 60 exit 1 61 | Ok repo -> 62 let seed_password = 63 match Sys.getenv_opt "HITO_SEED_PASSWORD" with 64 | Some p when p <> "" -> p 65 | _ -> 66 prerr_endline 67 "hito: HITO_SEED_PASSWORD is not set; refusing to seed the \ 68 account with a default. Set it and restart."; 69 exit 1 70 in 71 Lwt_main.run (seed_single_user repo ~password:seed_password); 72 let handlers = Handlers.make ~repo () in 73 Dream.run ~interface:"localhost" ~port 74 ~error_handler:Handlers.error_handler 75 @@ Dream.logger @@ Dream.set_secret secret @@ Dream.sql_pool db_uri 76 @@ Dream.sql_sessions 77 @@ Dream.router (Handlers.routes handlers) 78