[OCaml] High Intensity Training Online

feat enhance app shell navigation

Keep the server responsible for every workflow and validation outcome while\nletting the client replace rendered shells in place. This preserves the\nCSRF-protected no-JavaScript path and prevents late responses from replacing\nnewer UI state.

Commit
b1abbc96048fcb5194db393be79e93b79ed92aeb
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
ARCHITECTURE.md
index 85f360cd..a0c237d3 100644..100644
@@ -71,15 +71,15 @@
71 71 `Trainee.id`. There is no server-wide state: a trainee's active routine and
72 72 workout in progress are stored, not held in a slot.
73 73 - **`hito.web`** — `Routes`, `Decode`, `Pages`, `Handlers`, and a
74 Removed: workout-only `js_of_ocaml` client. Dream and dream-html live only here.
74 Added: authenticated-app `js_of_ocaml` client. Dream and dream-html live only here.
75 75 Wall-clock time enters here, never in the core.
76 76 `Handlers` is a functor over `Repository.S`, so production runs on
77 Removed: `Sqlite_repo` while tests run on `Memory_repo`. The current workout page ships
78 Removed: a small `js_of_ocaml` enhancement client: it replaces only marked exercise
79 Removed: panels and record/correction responses in place. Its server-rendered links
80 Removed: and CSRF-protected forms remain the fallback, so Home, Routine, Logbook,
81 Removed: saved history, finish/cancel, and every JavaScript-disabled workflow keep
82 Removed: ordinary browser navigation. Authentication uses one
77 Added: `Sqlite_repo` while tests run on `Memory_repo`. Authenticated pages ship a
78 Added: small `js_of_ocaml` enhancement client: it replaces marked app content for
79 Added: navigation, routine selection, workout start/finish/cancel, saved-record
80 Added: edits, current workout logging, sign-in, registration, and sign-out. Every
81 Added: JavaScript-disabled workflow retains ordinary browser navigation and
82 Added: CSRF-protected server forms. Authentication uses one
83 83 `authenticated` combinator: it resolves the signed-in trainee and passes it
84 84 to a continuation, so a route with any number of path captures shares one
85 85 gate. Every domain and service error becomes a user-facing sentence in one
lib/web/pages.ml
index 9c8d1534..c4dff461 100644..100644
@@ -20,9 +20,14 @@
20 20 (* The shell. [trainee] and [request] are present on authenticated pages, which
21 21 then show a logout control and the username on the history link. Auth pages
22 22 omit both. *)
23 Removed: let html_page ?trainee ?request ?(active = "") ?(workout_client = false) title
24 Removed: content =
25 Removed: let nav_link path label = tag "a" [ href path ] [ txt "%s" label ] in
23 Added: let html_page ?trainee ?request ?(active = "") title content =
24 Added: let spa_client = true in
25 Added: let nav_link path label =
26 Added: tag "a"
27 Added: ([ href path ]
28 Added: @ if spa_client then [ Dream_html.attr "data-hito-app-link" ] else [])
29 Added: [ txt "%s" label ]
30 Added: in
26 31 let navigation_links username =
27 32 [
28 33 nav_link Routes.home "Overview";
@@ -39,8 +44,13 @@
39 44 [ class_ "account" ]
40 45 [
41 46 tag "form"
42 Removed: [ action Routes.logout; post_form; class_ "logout" ]
43 47 [
48 Added: action Routes.logout;
49 Added: post_form;
50 Added: class_ "logout";
51 Added: Dream_html.attr "data-hito-app-form";
52 Added: ]
53 Added: [
44 54 Dream_html.csrf_tag request;
45 55 void "input" [ type_ "submit"; value "Sign out" ];
46 56 ];
@@ -86,8 +96,13 @@
86 96 (navigation_links (Trainee.username_to_string trainee.username)
87 97 @ [
88 98 tag "form"
89 Removed: [ action Routes.logout; post_form; class_ "logout" ]
90 99 [
100 Added: action Routes.logout;
101 Added: post_form;
102 Added: class_ "logout";
103 Added: Dream_html.attr "data-hito-app-form";
104 Added: ]
105 Added: [
91 106 Dream_html.csrf_tag request;
92 107 void "input" [ type_ "submit"; value "Sign out" ];
93 108 ];
@@ -127,31 +142,50 @@
127 142 [ Dream_html.string_attr "class" "hito-app page-%s" active ]
128 143 ([
129 144 tag "div"
130 Removed: [ class_ "app-shell" ]
131 Removed: [
132 Removed: tag "header"
133 Removed: [ class_ "masthead" ]
134 Removed: ([
135 Removed: tag "a"
136 Removed: [ class_ "brand"; href Routes.home ]
137 Removed: [
138 Removed: tag "span" [ class_ "brand-mark" ] [ txt "HD" ];
139 Removed: tag "span"
140 Removed: [ class_ "brand-copy" ]
141 Removed: [
142 Removed: tag "strong" [] [ txt "hito" ];
143 Removed: tag "small" []
144 Removed: [ txt "High Intensity Tracker Online" ];
145 Removed: ];
146 Removed: ];
147 Removed: ]
148 Removed: @ primary_nav @ account_area @ menu);
149 Removed: tag "main" [] [ tag "div" [ class_ "page-surface" ] content ];
150 Removed: ];
145 Added: ([
146 Added: Dream_html.string_attr "class" "app-shell page-%s" active;
147 Added: Dream_html.string_attr "data-hito-page-title" "%s — hito" title;
148 Added: ]
149 Added: @
150 Added: if spa_client then [ Dream_html.attr "data-hito-app-shell" ]
151 Added: else [])
152 Added: ([
153 Added: tag "header"
154 Added: [ class_ "masthead" ]
155 Added: ([
156 Added: tag "a"
157 Added: ([ class_ "brand"; href Routes.home ]
158 Added: @
159 Added: if spa_client then
160 Added: [ Dream_html.attr "data-hito-app-link" ]
161 Added: else [])
162 Added: [
163 Added: tag "span" [ class_ "brand-mark" ] [ txt "HD" ];
164 Added: tag "span"
165 Added: [ class_ "brand-copy" ]
166 Added: [
167 Added: tag "strong" [] [ txt "hito" ];
168 Added: tag "small" []
169 Added: [ txt "High Intensity Tracker Online" ];
170 Added: ];
171 Added: ];
172 Added: ]
173 Added: @ primary_nav @ account_area @ menu);
174 Added: tag "main" []
175 Added: [
176 Added: tag "div"
177 Added: ([ class_ "page-surface" ]
178 Added: @
179 Added: if spa_client then
180 Added: [ Dream_html.attr "data-hito-app-content" ]
181 Added: else [])
182 Added: content;
183 Added: ];
184 Added: ]
185 Added: @ bottom_nav);
151 186 ]
152 Removed: @ bottom_nav
153 187 @
154 Removed: if workout_client then
188 Added: if spa_client then
155 189 [
156 190 tag "script"
157 191 [ src Routes.workout_client; Dream_html.attr "defer" ]
@@ -176,7 +210,7 @@
176 210
177 211 let credentials_form request ~submit ~action_path =
178 212 tag "form"
179 Removed: [ action action_path; post_form ]
213 Added: [ action action_path; post_form; Dream_html.attr "data-hito-app-form" ]
180 214 [
181 215 Dream_html.csrf_tag request;
182 216 tag "div"
@@ -219,7 +253,9 @@
219 253 tag "p" []
220 254 [
221 255 txt "No account yet? ";
222 Removed: tag "a" [ href Routes.register ] [ txt "Register" ];
256 Added: tag "a"
257 Added: [ href Routes.register; Dream_html.attr "data-hito-app-link" ]
258 Added: [ txt "Register" ];
223 259 ];
224 260 ]
225 261 else []
@@ -239,7 +275,9 @@
239 275 tag "p" []
240 276 [
241 277 txt "Already registered? ";
242 Removed: tag "a" [ href Routes.login ] [ txt "Sign in" ];
278 Added: tag "a"
279 Added: [ href Routes.login; Dream_html.attr "data-hito-app-link" ]
280 Added: [ txt "Sign in" ];
243 281 ];
244 282 ]
245 283 @ auth_error error)
@@ -288,7 +326,9 @@
288 326 (fun (routine_id, routine) ->
289 327 tag "form"
290 328 [
291 Removed: action Routes.select_routine (id_string routine_id); post_form;
329 Added: action Routes.select_routine (id_string routine_id);
330 Added: post_form;
331 Added: Dream_html.attr "data-hito-app-form";
292 332 ]
293 333 [
294 334 Dream_html.csrf_tag request;
@@ -309,7 +349,7 @@
309 349
310 350 let begin_form request ~routine ~override label =
311 351 tag "form"
312 Removed: [ action Routes.workout; post_form ]
352 Added: [ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form" ]
313 353 [
314 354 Dream_html.csrf_tag request;
315 355 void "input"
@@ -505,7 +545,9 @@
505 545 in
506 546 tag "form"
507 547 ([ action_path; post_form ]
508 Removed: @ if enhanced then [ Dream_html.attr "data-hito-workout-form" ] else [])
548 Added: @
549 Added: if enhanced then [ Dream_html.attr "data-hito-workout-form" ]
550 Added: else [ Dream_html.attr "data-hito-app-form" ])
509 551 [
510 552 Dream_html.csrf_tag request;
511 553 tag "fieldset" []
@@ -736,14 +778,22 @@
736 778 [ class_ "button-group" ]
737 779 [
738 780 tag "form"
739 Removed: [ action Routes.finish_workout; post_form ]
740 781 [
782 Added: action Routes.finish_workout;
783 Added: post_form;
784 Added: Dream_html.attr "data-hito-app-form";
785 Added: ]
786 Added: [
741 787 Dream_html.csrf_tag request;
742 788 void "input" [ type_ "submit"; value "Finish workout" ];
743 789 ];
744 790 tag "form"
745 Removed: [ action Routes.cancel_workout; post_form ]
746 791 [
792 Added: action Routes.cancel_workout;
793 Added: post_form;
794 Added: Dream_html.attr "data-hito-app-form";
795 Added: ]
796 Added: [
747 797 Dream_html.csrf_tag request;
748 798 void "input"
749 799 [
@@ -753,7 +803,7 @@
753 803 ];
754 804 ]
755 805 in
756 Removed: html_page ~trainee ~request ~active:"workout" ~workout_client:enhanced
806 Added: html_page ~trainee ~request ~active:"workout"
757 807 (Prescription.Workout.name prescription)
758 808 [
759 809 tag "div"
@@ -815,7 +865,10 @@
815 865 tag "li" []
816 866 [
817 867 tag "a"
818 Removed: [ href Routes.record (record.Repository.id :> string) ]
868 Added: [
869 Added: href Routes.record (record.Repository.id :> string);
870 Added: Dream_html.attr "data-hito-app-link";
871 Added: ]
819 872 [
820 873 txt "%s — %d stimuli"
821 874 (Prescription.Workout.name
lib/web/pages.mli
index d1961cda..f03c5f09 100644..100644
@@ -36,11 +36,12 @@
36 36 Evidence.Workout.t ->
37 37 page
38 38 (** Renders one prescribed slot at a time under a vertical group of named
39 Removed: exercise buttons. Current workouts carry progressive-enhancement markers for
40 Removed: the js_of_ocaml client, while saved records always use ordinary links and
41 Removed: forms. [active_slot] selects the visible button; a handler clamps a
42 Removed: requested slot and falls back to {!default_slot}. [record_id] is [None] for
43 Removed: the workout in progress and [Some id] for a saved history record. *)
39 Added: exercise buttons. Authenticated pages carry generic progressive-enhancement
40 Added: markers; current workouts additionally mark slot links and forms, while
41 Added: saved-record edits use the generic authenticated form path. [active_slot]
42 Added: button; a handler clamps a requested slot and falls back to {!default_slot}.
43 Added: [record_id] is [None] for the workout in progress and [Some id] for a saved
44 Added: history record. *)
44 45
45 46 val default_slot : Evidence.Workout.t -> int
46 47 (** The slot a workout view opens on: the first slot still awaiting a record, or
lib/web/workout_client.ml
index b20167f5..ade74a98 100644..100644
@@ -1,9 +1,8 @@
1 1 open Js_of_ocaml
2 2 open Lwt.Infix
3 3
4 Removed: let selector = "[data-hito-workout-content]"
5 Removed: let enhanced_link = "a[data-hito-workout-link]"
6 Removed: let enhanced_form = "form[data-hito-workout-form]"
4 Added: let workout_selector = "[data-hito-workout-content]"
5 Added: let app_selector = "[data-hito-app-shell]"
7 6 let document = Dom_html.document
8 7 let request_number = ref 0
9 8
@@ -17,50 +16,68 @@
17 16 | None -> None
18 17 | Some node -> Js.Opt.to_option (Dom_html.CoerceTo.element node)
19 18
19 Added: let set_busy busy =
20 Added: match query_one document app_selector with
21 Added: | Some shell ->
22 Added: shell##setAttribute (Js.string "aria-busy")
23 Added: (Js.string (if busy then "true" else "false"))
24 Added: | None -> ()
25 Added:
26 Added: let fallback url = Dom_html.window##.location##assign (Js.string url)
27 Added:
20 28 let announce message =
21 29 match query_one document "[data-hito-workout-status]" with
22 30 | Some status -> status##.textContent := Js.some (Js.string message)
23 31 | None -> ()
24 32
25 Removed: let fallback url = Dom_html.window##.location##assign (Js.string url)
26 Removed:
27 Removed: let replace_from_html html =
33 Added: let replace selector html =
28 34 let next = Dom_html.createDiv document in
29 35 next##.innerHTML := Js.string html;
30 36 match (query_one document selector, query_one next selector) with
31 37 | Some current, Some replacement ->
32 38 let parent = Js.Opt.get current##.parentNode (fun () -> assert false) in
33 39 Dom.replaceChild parent replacement current;
34 Removed: (match query_one document "[data-hito-workout-content] h1" with
40 Added: (match
41 Added: Js.Opt.to_option
42 Added: (replacement##getAttribute (Js.string "data-hito-page-title"))
43 Added: with
44 Added: | Some title -> document##.title := title
45 Added: | None -> ());
46 Added: (match query_one document (selector ^ " h1, " ^ selector ^ " h2") with
35 47 | Some heading ->
36 48 heading##setAttribute (Js.string "tabindex") (Js.string "-1");
37 49 heading##focus
38 50 | None -> ());
39 Removed: announce "Workout updated";
51 Added: announce "Page updated";
40 52 true
41 53 | _ -> false
42 54
43 Removed: let get ?(push = false) url =
55 Added: let replace_app = replace app_selector
56 Added: let replace_workout = replace workout_selector
57 Added:
58 Added: let push_url url =
59 Added: Dom_html.window##.history##pushState
60 Added: Js.null (Js.string "")
61 Added: (Js.some (Js.string url))
62 Added:
63 Added: let get ?(push = false) ?(workout = false) url =
44 64 incr request_number;
45 65 let request = !request_number in
46 Removed: announce "Loading workout";
47 Removed: Js_of_ocaml_lwt.XmlHttpRequest.perform_raw_url ~with_credentials:true
48 Removed: ~headers:[ ("X-Hito-Workout", "1") ]
49 Removed: url
66 Added: set_busy true;
67 Added: announce "Loading";
68 Added: Js_of_ocaml_lwt.XmlHttpRequest.perform_raw_url ~with_credentials:true url
50 69 >>= fun response ->
70 Added: let replace = if workout then replace_workout else replace_app in
51 71 if request <> !request_number then Lwt.return_unit
52 Removed: else if
53 Removed: response.code >= 200 && response.code < 300
54 Removed: && replace_from_html response.content
55 Removed: then (
56 Removed: if push then
57 Removed: Dom_html.window##.history##pushState
58 Removed: Js.null (Js.string "")
59 Removed: (Js.some (Js.string url));
60 Removed: Lwt.return_unit)
61 72 else (
62 Removed: fallback url;
63 Removed: Lwt.return_unit)
73 Added: set_busy false;
74 Added: if response.code >= 200 && response.code < 300 && replace response.content
75 Added: then (
76 Added: if push then push_url url;
77 Added: Lwt.return_unit)
78 Added: else (
79 Added: fallback url;
80 Added: Lwt.return_unit))
64 81
65 82 let modified event =
66 83 Js.to_bool event##.metaKey
@@ -68,18 +85,28 @@
68 85 || Js.to_bool event##.shiftKey
69 86 || Js.to_bool event##.altKey
70 87
88 Added: let href link =
89 Added: Js.Opt.to_option (link##getAttribute (Js.string "href"))
90 Added: |> Option.map Js.to_string
91 Added:
71 92 let link_click event =
72 93 if event##.button <> 0 || modified event then Js._true
73 94 else
74 Removed: match closest enhanced_link (Dom_html.eventTarget event) with
95 Added: match
96 Added: closest "a[data-hito-app-link], a[data-hito-workout-link]"
97 Added: (Dom_html.eventTarget event)
98 Added: with
75 99 | None -> Js._true
76 100 | Some link -> (
77 Removed: match Js.Opt.to_option (link##getAttribute (Js.string "href")) with
101 Added: match href link with
78 102 | None -> Js._true
79 Removed: | Some href ->
80 Removed: let url = Js.to_string href in
103 Added: | Some url ->
81 104 Dom.preventDefault event;
82 Removed: Lwt.async (fun () -> get ~push:true url);
105 Added: let workout =
106 Added: Js.to_bool
107 Added: (link##hasAttribute (Js.string "data-hito-workout-link"))
108 Added: in
109 Added: Lwt.async (fun () -> get ~push:true ~workout url);
83 110 Js._false)
84 111
85 112 let slot_from_action action =
@@ -88,7 +115,10 @@
88 115 | [] -> ""
89 116
90 117 let form_submit event =
91 Removed: match closest enhanced_form (Dom_html.eventTarget event) with
118 Added: match
119 Added: closest "form[data-hito-app-form], form[data-hito-workout-form]"
120 Added: (Dom_html.eventTarget event)
121 Added: with
92 122 | None -> Js._true
93 123 | Some element -> (
94 124 match Js.Opt.to_option (Dom_html.CoerceTo.form element) with
@@ -100,9 +130,13 @@
100 130 Js.Opt.to_option (form##getAttribute (Js.string "action"))
101 131 with
102 132 | Some action -> Js.to_string action
103 Removed: | None -> "/workout"
133 Added: | None -> "/"
104 134 in
105 Removed: let slot = slot_from_action action in
135 Added: incr request_number;
136 Added: let request = !request_number in
137 Added: let workout =
138 Added: Js.to_bool (form##hasAttribute (Js.string "data-hito-workout-form"))
139 Added: in
106 140 let submit =
107 141 match
108 142 Js.Opt.to_option
@@ -113,21 +147,33 @@
113 147 in
114 148 Dom.preventDefault event;
115 149 Option.iter (fun input -> input##.disabled := Js._true) submit;
116 Removed: announce "Saving workout";
150 Added: set_busy true;
151 Added: announce "Saving";
117 152 Lwt.async (fun () ->
118 153 Js_of_ocaml_lwt.XmlHttpRequest.perform_raw_url
119 154 ~with_credentials:true ~override_method:`POST
120 155 ~contents:(`Form_contents (Form.post_form_contents form))
121 156 action
122 157 >>= fun response ->
123 Removed: Option.iter (fun input -> input##.disabled := Js._false) submit;
124 Removed: if response.code = 400 && replace_from_html response.content then
125 Removed: Lwt.return_unit
126 Removed: else if response.code >= 200 && response.code < 300 then
127 Removed: get ("/workout?slot=" ^ slot)
158 Added: if request <> !request_number then Lwt.return_unit
128 159 else (
129 Removed: fallback action;
130 Removed: Lwt.return_unit));
160 Added: set_busy false;
161 Added: Option.iter (fun input -> input##.disabled := Js._false) submit;
162 Added: let replace =
163 Added: if workout then replace_workout else replace_app
164 Added: in
165 Added: if response.code = 400 && replace response.content then
166 Added: Lwt.return_unit
167 Added: else if workout && response.code >= 200 && response.code < 300
168 Added: then
169 Added: get ~workout:true ("/workout?slot=" ^ slot_from_action action)
170 Added: else if response.code < 500 && replace response.content then (
171 Added: if response.code >= 200 && response.code < 300 then
172 Added: push_url response.url;
173 Added: Lwt.return_unit)
174 Added: else (
175 Added: fallback action;
176 Added: Lwt.return_unit)));
131 177 Js._false)
132 178
133 179 let popstate _ =
test/test_web.ml
index 37c9fc4b..e4b4e7ea 100644..100644
@@ -143,7 +143,12 @@
143 143 (contains ~substring:"dream.csrf" page);
144 144 Alcotest.(check bool)
145 145 "has a password field" true
146 Removed: (contains ~substring:"type=\"password\"" page) );
146 Added: (contains ~substring:"type=\"password\"" page);
147 Added: Alcotest.(check bool)
148 Added: "loads the app client and marks the sign-in form" true
149 Added: (contains ~substring:"data-hito-app-shell" page
150 Added: && contains ~substring:"data-hito-app-form" page
151 Added: && contains ~substring:"/assets/workout-client.js" page) );
147 152 ( "registration signs the trainee in and reaches the overview",
148 153 `Quick,
149 154 fun () ->
@@ -158,8 +163,8 @@
158 163 (contains ~substring:"Routines" (body overview));
159 164 Alcotest.(check bool)
160 165 "shows the username in history navigation" true
161 Removed: (contains ~substring:"href=\"/history\">lifter</a>"
162 Removed: (body overview));
166 Added: (contains ~substring:"href=\"/history\"" (body overview)
167 Added: && contains ~substring:">lifter</a>" (body overview));
163 168 Alcotest.(check bool)
164 169 "omits the header username" false
165 170 (contains ~substring:"account-username" (body overview));
@@ -331,6 +336,15 @@
331 336 let c = client () in
332 337 let _ = sign_in_new c in
333 338 let select_page = body (get c "/") in
339 Added: Alcotest.(check bool)
340 Added: "enhances authenticated overview navigation" true
341 Added: (contains ~substring:"data-hito-app-link" select_page
342 Added: && contains ~substring:"data-hito-app-content" select_page
343 Added: && contains ~substring:"data-hito-page-title" select_page
344 Added: && contains ~substring:"/assets/workout-client.js" select_page);
345 Added: Alcotest.(check bool)
346 Added: "marks routine selection for in-place submission" true
347 Added: (contains ~substring:"data-hito-app-form" select_page);
334 348 let token = Option.get (csrf_token select_page) in
335 349 let selection =
336 350 post c "/routines/ideal/select" [ ("dream.csrf", token) ]
@@ -534,8 +548,15 @@
534 548 "does not mark saved history as replaceable workout content" false
535 549 (contains ~substring:"data-hito-workout-content" record_page);
536 550 Alcotest.(check bool)
537 Removed: "does not load the workout client for saved history" false
551 Added: "marks saved history as generic app content" true
552 Added: (contains ~substring:"data-hito-app-content" record_page);
553 Added: Alcotest.(check bool)
554 Added: "loads the app client for saved history navigation" true
538 555 (contains ~substring:"/assets/workout-client.js" record_page);
556 Added: Alcotest.(check bool)
557 Added: "enhances saved-slot corrections through the generic form path"
558 Added: true
559 Added: (contains ~substring:"data-hito-app-form" record_page);
539 560 Alcotest.(check bool)
540 561 "offers a saved-slot correction form" true
541 562 (contains ~substring:"/history/w1/slots/1/edit" record_page);