[OCaml] High Intensity Training Online
feat add branded error pages
Serve a branded page for HTTP failures. A catch-all route renders the 404 for any unclaimed path and keeps the navigation, so an unknown URL stays one tap from a known destination. Handlers.error_handler, wired into Dream.run, covers 5xx responses and uncaught exceptions. The page names only the failure class, so no server string leaks.
Changed files
ARCHITECTURE.org
@@ -309,6 +309,12 @@
309
309
continuation, so a route with any number of path captures shares one gate. Every
310
310
state-changing POST verifies a signed CSRF token.
311
311
312
Added:
Every failure renders a branded page that names only the class of failure, so
313
Added:
no server string leaks. A catch-all route serves the =404= for any unclaimed
314
Added:
path and keeps the navigation, so an unknown URL is one tap from a known
315
Added:
destination. =Handlers.error_handler=, wired into =Dream.run=, covers the rest:
316
Added:
=5xx= responses and uncaught exceptions.
317
Added:
312
318
* The cycle
313
319
314
320
#+begin_src mermaid
bin/main.ml
@@ -71,6 +71,7 @@
71
71
Lwt_main.run (seed_single_user repo ~password:seed_password);
72
72
let handlers = Handlers.make ~repo () in
73
73
Dream.run ~interface:"localhost" ~port
74
Added:
~error_handler:Handlers.error_handler
74
75
@@ Dream.logger @@ Dream.set_secret secret @@ Dream.sql_pool db_uri
75
76
@@ Dream.sql_sessions
76
77
@@ Dream.router (Handlers.routes handlers)
lib/web/handlers.ml
@@ -641,8 +641,27 @@
641
641
]
642
642
end
643
643
644
Added:
(* A catch-all for any path no route claims. It renders the branded 404 so an
645
Added:
unknown URL keeps the navigation and leaks nothing, rather than the empty
646
Added:
body Dream's router would return. Kept last so it never shadows a real
647
Added:
route. The production [error_handler] covers the rest: [5xx] responses and
648
Added:
uncaught exceptions. *)
649
Added:
let catch_all =
650
Added:
Dream.any "/**" (fun _ ->
651
Added:
html ~status:`Not_Found (Pages.error_page ~status:404))
652
Added:
644
653
let routes t =
645
654
Auth.routes t @ Overview.routes t @ Current_workout.routes t
646
655
@ Logbook.routes t @ App_feedback.routes t @ Profile.routes t
647
Removed:
@ Assets.routes
656
Added:
@ Assets.routes @ [ catch_all ]
657
Added:
658
Added:
(* A branded error page for every failure Dream routes here: unmatched paths,
659
Added:
[4xx] and [5xx] responses, and uncaught exceptions. The page names only the
660
Added:
status class, never a server string, so nothing internal leaks. The status
661
Added:
of the suggested response is preserved. *)
662
Added:
let error_handler =
663
Added:
Dream.error_template (fun _error _message suggested ->
664
Added:
let status = Dream.status suggested |> Dream.status_to_int in
665
Added:
Dream_html.set_body suggested (Pages.error_page ~status);
666
Added:
Lwt.return suggested)
648
667
end
lib/web/handlers.mli
@@ -19,4 +19,9 @@
19
19
(** The route table. Session and CSRF middleware are applied per handler; wrap
20
20
with {!Dream.sql_sessions} or {!Dream.memory_sessions} and a secret at the
21
21
top level. *)
22
Added:
23
Added:
val error_handler : Dream.error_handler
24
Added:
(** Renders a branded page for every failure Dream routes here, including
25
Added:
unmatched paths and [5xx] responses. Pass to {!Dream.run}
26
Added:
[~error_handler]. It leaks no server-supplied string. *)
22
27
end
lib/web/pages.ml
@@ -22,8 +22,8 @@
22
22
(* The shell. [trainee] and [request] are present on authenticated pages, which
23
23
then show a logout control and the username on the history link. Auth pages
24
24
omit both. *)
25
Removed:
let html_page ?trainee ?request ?(active = "") ?(logging = false) title content
26
Removed:
=
25
Added:
let html_page ?trainee ?request ?(active = "") ?(logging = false)
26
Added:
?(show_nav = false) title content =
27
27
let spa_client = true in
28
28
let nav_link page path label =
29
29
let attrs = [ href path ] in
@@ -107,6 +107,8 @@
107
107
match (trainee, request) with
108
108
| Some (_ : Trainee.t), Some _ ->
109
109
[ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ]
110
Added:
| _ when show_nav ->
111
Added:
[ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ]
110
112
| _ -> []
111
113
in
112
114
let bottom_nav =
@@ -120,6 +122,15 @@
120
122
]
121
123
(navigation_links ());
122
124
]
125
Added:
| _ when show_nav ->
126
Added:
[
127
Added:
tag "nav"
128
Added:
[
129
Added:
class_ "bottom-nav";
130
Added:
Dream_html.string_attr "aria-label" "Mobile navigation";
131
Added:
]
132
Added:
(navigation_links ());
133
Added:
]
123
134
| _ -> []
124
135
in
125
136
tag "html"
@@ -194,6 +205,28 @@
194
205
html_page title
195
206
[
196
207
tag "p" [ class_ "eyebrow" ] [ txt "Attention required" ];
208
Added:
tag "h1" [] [ txt "%s" title ];
209
Added:
tag "p" [ class_ "warn" ] [ txt "%s" detail ];
210
Added:
]
211
Added:
212
Added:
(* A branded error page for the common HTTP failures. It states only the class
213
Added:
of failure, never a server-supplied string, so nothing internal leaks. The
214
Added:
navigation stays present — top on desktop, bottom on mobile — so a lost
215
Added:
visitor is one tap from a known destination. *)
216
Added:
let error_page ~status =
217
Added:
let title, detail =
218
Added:
match status with
219
Added:
| 404 ->
220
Added:
("Page not found", "That page does not exist. Use the navigation below.")
221
Added:
| 400 -> ("Bad request", "That request could not be understood.")
222
Added:
| 403 -> ("Forbidden", "You do not have access to that page.")
223
Added:
| s when s >= 500 ->
224
Added:
("Something went wrong", "The server hit a problem. Try again shortly.")
225
Added:
| _ -> ("Something went wrong", "That request could not be completed.")
226
Added:
in
227
Added:
html_page ~show_nav:true title
228
Added:
[
229
Added:
tag "p" [ class_ "eyebrow" ] [ txt "%d" status ];
197
230
tag "h1" [] [ txt "%s" title ];
198
231
tag "p" [ class_ "warn" ] [ txt "%s" detail ];
199
232
]
lib/web/pages.mli
@@ -86,6 +86,11 @@
86
86
87
87
val problem : title:string -> detail:string -> page
88
88
89
Added:
val error_page : status:int -> page
90
Added:
(** A branded page for an HTTP failure. It names only the class of failure, so
91
Added:
no server-supplied string leaks, and keeps the navigation affordances: top
92
Added:
on desktop, bottom on mobile. *)
93
Added:
89
94
val app_feedback :
90
95
Dream.request ->
91
96
?logging:bool ->
test/test_web.ml
@@ -1210,6 +1210,41 @@
1210
1210
(List.mem "/profile?changed=password"
1211
1211
(Dream.headers changed "Location")) );
1212
1212
] );
1213
Added:
( "web.errors",
1214
Added:
[
1215
Added:
( "an unknown path renders a branded 404 with navigation",
1216
Added:
`Quick,
1217
Added:
fun () ->
1218
Added:
let c = client () in
1219
Added:
let response = get c "/no-such-page" in
1220
Added:
Alcotest.(check int) "responds 404" 404 (status response);
1221
Added:
let page = body response in
1222
Added:
Alcotest.(check bool)
1223
Added:
"names the failure without leaking server detail" true
1224
Added:
(contains ~substring:"Page not found" page);
1225
Added:
Alcotest.(check bool)
1226
Added:
"keeps the desktop top navigation" true
1227
Added:
(contains ~substring:"primary-nav" page);
1228
Added:
Alcotest.(check bool)
1229
Added:
"keeps the mobile bottom navigation" true
1230
Added:
(contains ~substring:"bottom-nav" page);
1231
Added:
Alcotest.(check bool)
1232
Added:
"offers a route back Home" true
1233
Added:
(contains ~substring:"href=\"/\"" page) );
1234
Added:
( "the 404 page never depends on a session",
1235
Added:
`Quick,
1236
Added:
fun () ->
1237
Added:
(* No sign-in: an unauthenticated visitor still gets the branded
1238
Added:
page and its navigation, not an empty body. *)
1239
Added:
let c = client () in
1240
Added:
let page = body (get c "/deep/unknown/path") in
1241
Added:
Alcotest.(check bool)
1242
Added:
"renders the branded page" true
1243
Added:
(contains ~substring:"Page not found" page);
1244
Added:
Alcotest.(check bool)
1245
Added:
"shows navigation actions" true
1246
Added:
(contains ~substring:"Logbook" page) );
1247
Added:
] );
1213
1248
]
1214
1249
1215
1250
let suite = route_tests