1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.auth", 7 [ 8 ( "an unauthenticated visit to the overview redirects to sign-in", 9 `Quick, 10 fun () -> 11 let c = client () in 12 let response = get c "/" in 13 Alcotest.(check int) "redirect" 303 (status response); 14 Alcotest.(check string) "to /login" "/login" (location response) ); 15 ( "the sign-in page is served", 16 `Quick, 17 fun () -> 18 let c = client () in 19 Alcotest.(check int) "GET /login" 200 (status (get c "/login")) ); 20 ( "every response carries the browser hardening headers", 21 `Quick, 22 fun () -> 23 let c = client () in 24 let response = get c "/login" in 25 let header name = Dream.header response name in 26 Alcotest.(check bool) 27 "a same-origin CSP that refuses framing" true 28 (match header "Content-Security-Policy" with 29 | Some csp -> 30 Option.is_some (index_from ~needle:"default-src 'self'" csp 0) 31 && Option.is_some 32 (index_from ~needle:"frame-ancestors 'none'" csp 0) 33 | None -> false); 34 Alcotest.(check (option string)) 35 "framing denied" (Some "DENY") (header "X-Frame-Options"); 36 Alcotest.(check (option string)) 37 "no type sniffing" (Some "nosniff") 38 (header "X-Content-Type-Options"); 39 Alcotest.(check (option string)) 40 "strict referrer" (Some "strict-origin-when-cross-origin") 41 (header "Referrer-Policy") ); 42 ( "signing in rotates the session identifier", 43 `Quick, 44 fun () -> 45 (* A session identifier that existed before authentication must not 46 survive into the authenticated session. Otherwise an attacker 47 who planted the identifier would inherit the login (session 48 fixation). Read the pre-login cookie, sign in, and confirm the 49 cookie the server now sets is different. *) 50 let session_cookie c = 51 List.find_opt 52 (fun cookie -> 53 String.length cookie >= 13 54 && String.sub cookie 0 13 = "dream.session") 55 c.jar 56 in 57 let c = client () in 58 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 59 (* Sign out, then obtain a fresh anonymous session cookie. *) 60 let token = Option.get (csrf_token (body (get c "/"))) in 61 let _ = post c "/logout" [ ("dream.csrf", token) ] in 62 let _ = get c "/login" in 63 let before = session_cookie c in 64 Alcotest.(check bool) 65 "an anonymous session cookie exists before sign-in" true 66 (Option.is_some before); 67 let token = Option.get (csrf_token (body (get c "/login"))) in 68 let _ = 69 post c "/login" 70 [ 71 ("dream.csrf", token); 72 ("username", "lifter"); 73 ("password", "heavyduty1"); 74 ] 75 in 76 let after = session_cookie c in 77 Alcotest.(check bool) 78 "a session cookie exists after sign-in" true 79 (Option.is_some after); 80 Alcotest.(check bool) 81 "the session identifier changed on sign-in" true (before <> after) 82 ); 83 ( "repeated sign-in attempts from one client are throttled", 84 `Quick, 85 fun () -> 86 (* Online password guessing is bounded per client: ten attempts a 87 minute. The eleventh is refused with 429 before any credential 88 check, and a wrong password never becomes a right one by 89 repetition. *) 90 let c = client () in 91 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 92 let token = Option.get (csrf_token (body (get c "/"))) in 93 let _ = post c "/logout" [ ("dream.csrf", token) ] in 94 let attempt () = 95 let token = Option.get (csrf_token (body (get c "/login"))) in 96 post c "/login" 97 [ 98 ("dream.csrf", token); 99 ("username", "lifter"); 100 ("password", "wrong"); 101 ] 102 in 103 for _ = 1 to 10 do 104 Alcotest.(check int) 105 "a wrong password is refused" 401 106 (status (attempt ())) 107 done; 108 Alcotest.(check int) 109 "the eleventh attempt is throttled" 429 110 (status (attempt ())); 111 (* Even the right password is refused while throttled. *) 112 let token = Option.get (csrf_token (body (get c "/login"))) in 113 let right = 114 post c "/login" 115 [ 116 ("dream.csrf", token); 117 ("username", "lifter"); 118 ("password", "heavyduty1"); 119 ] 120 in 121 Alcotest.(check int) 122 "a correct password is also refused while throttled" 429 123 (status right) ); 124 ( "registration creates the account, signs in, and reaches the overview", 125 `Quick, 126 fun () -> 127 let c, repo = client_with_repo () in 128 let registered = 129 register c ~username:"lifter" ~password:"heavyduty1" 130 in 131 Alcotest.(check int) 132 "registered, redirected" 303 (status registered); 133 (* The account now exists: the flow orchestrated a real create. *) 134 let trainee = the_trainee repo ~username:"lifter" in 135 Alcotest.(check string) 136 "stored under the normalized username" "lifter" 137 (Trainee.username_to_string trainee.Trainee.username); 138 (* The session authenticates the follow-up request. *) 139 Alcotest.(check int) 140 "authenticated overview" 200 141 (status (get c "/")) ); 142 ( "an authenticated trainee reaches the overview", 143 `Quick, 144 fun () -> 145 let c = client () in 146 let _ = sign_in_new c in 147 Alcotest.(check int) "home" 200 (status (get c "/")) ); 148 ( "sign-out clears the session", 149 `Quick, 150 fun () -> 151 let c = client () in 152 let _ = sign_in_new c in 153 let token = Option.get (csrf_token (body (get c "/"))) in 154 let out = post c "/logout" [ ("dream.csrf", token) ] in 155 Alcotest.(check int) "logout redirects" 303 (status out); 156 (* The session is gone: the overview again bounces to sign-in. *) 157 let after = get c "/" in 158 Alcotest.(check int) "overview now redirects" 303 (status after); 159 Alcotest.(check string) "to /login" "/login" (location after) ); 160 ( "a form post without a CSRF token is refused and changes nothing", 161 `Quick, 162 fun () -> 163 let c, repo = client_with_repo () in 164 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 165 let response = 166 post c "/routines/ideal/select" [ (* no dream.csrf *) ] 167 in 168 Alcotest.(check int) 169 "redirects after the refused post" 303 (status response); 170 (* No routine was selected: the refused post had no domain effect. *) 171 let trainee = the_trainee repo ~username:"lifter" in 172 Alcotest.(check bool) 173 "no active routine" true 174 (Option.is_none 175 (Lwt_main.run 176 (Test_repo.active_routine repo trainee.Trainee.id))) ); 177 ( "a too-short username is refused", 178 `Quick, 179 fun () -> 180 let c, repo = client_with_repo () in 181 let response = register c ~username:"abc" ~password:"heavyduty1" in 182 Alcotest.(check int) "rejected" 400 (status response); 183 Alcotest.(check (option string)) 184 "no account created" None 185 (Lwt_main.run 186 (match Trainee.username "abc" with 187 | Ok u -> Test_repo.find_trainee_by_username repo u 188 | Error _ -> Lwt.return None) 189 |> Option.map (fun t -> Trainee.id_to_string t.Trainee.id)) ); 190 ( "a too-long username is refused", 191 `Quick, 192 fun () -> 193 let c = client () in 194 let response = 195 register c ~username:"abcdefghijklmnopqrstu" 196 ~password:"heavyduty1" 197 in 198 Alcotest.(check int) "rejected" 400 (status response) ); 199 ( "a short password is accepted (passwords carry no policy)", 200 `Quick, 201 fun () -> 202 let c = client () in 203 let response = register c ~username:"lifter" ~password:"x" in 204 Alcotest.(check int) "registered, redirected" 303 (status response); 205 Alcotest.(check int) 206 "authenticated overview" 200 207 (status (get c "/")) ); 208 ( "with registration closed the register routes are absent", 209 `Quick, 210 fun () -> 211 (* The production default: [registration_open] unset. *) 212 let handlers = Handlers.make ~repo:(Test_repo.create ()) () in 213 let app = 214 Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) 215 |> fun h -> Dream.set_secret "test-secret-value" h 216 in 217 let c = { app; jar = [] } in 218 Alcotest.(check int) 219 "GET /register is not found" 404 220 (status (get c "/register")); 221 Alcotest.(check int) 222 "GET /login is served" 200 223 (status (get c "/login")) ); 224 ( "a returning trainee signs in with their credentials", 225 `Quick, 226 fun () -> 227 (* Register, then sign out, then sign back in through the credential 228 form. This exercises [POST /login], which registration's 229 auto-sign-in never touches. *) 230 let c = client () in 231 let _ = sign_in_new c in 232 let token = Option.get (csrf_token (body (get c "/"))) in 233 let _ = post c "/logout" [ ("dream.csrf", token) ] in 234 Alcotest.(check int) 235 "signed out, overview redirects" 303 236 (status (get c "/")); 237 let signed_in = 238 sign_in c ~username:"lifter" ~password:"heavyduty1" 239 in 240 Alcotest.(check int) "sign-in redirects" 303 (status signed_in); 241 Alcotest.(check bool) 242 "sign-in lands on Home" true 243 (List.mem "/" (Dream.headers signed_in "Location")); 244 Alcotest.(check int) 245 "authenticated overview" 200 246 (status (get c "/")) ); 247 ( "a wrong password is refused and establishes no session", 248 `Quick, 249 fun () -> 250 let c = client () in 251 let _ = sign_in_new c in 252 let token = Option.get (csrf_token (body (get c "/"))) in 253 let _ = post c "/logout" [ ("dream.csrf", token) ] in 254 let refused = 255 sign_in c ~username:"lifter" ~password:"not-the-password" 256 in 257 Alcotest.(check int) "rejected" 401 (status refused); 258 (* The rejected attempt establishes no session. *) 259 Alcotest.(check int) 260 "still unauthenticated" 303 261 (status (get c "/")) ); 262 ( "an unknown username is refused like a wrong password", 263 `Quick, 264 fun () -> 265 let c = client () in 266 let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in 267 Alcotest.(check int) "rejected" 401 (status refused); 268 Alcotest.(check int) 269 "no session established" 303 270 (status (get c "/")) ); 271 ( "an already-authenticated visit to the sign-in page redirects Home", 272 `Quick, 273 fun () -> 274 let c = client () in 275 let _ = sign_in_new c in 276 let response = get c "/login" in 277 Alcotest.(check int) "redirects" 303 (status response); 278 Alcotest.(check bool) 279 "sends an authenticated visitor Home" true 280 (List.mem "/" (Dream.headers response "Location")) ); 281 ( "an already-authenticated visit to the register page redirects Home", 282 `Quick, 283 fun () -> 284 let c = client () in 285 let _ = sign_in_new c in 286 let response = get c "/register" in 287 Alcotest.(check int) "redirects" 303 (status response); 288 Alcotest.(check bool) 289 "sends an authenticated visitor Home" true 290 (List.mem "/" (Dream.headers response "Location")) ); 291 ( "signing out returns the trainee to the sign-in page", 292 `Quick, 293 fun () -> 294 let c = client () in 295 let _ = sign_in_new c in 296 let page = body (get c "/") in 297 let token = Option.get (csrf_token page) in 298 let out = post c "/logout" [ ("dream.csrf", token) ] in 299 Alcotest.(check int) "logout redirect" 303 (status out); 300 let after = get c "/" in 301 Alcotest.(check int) "overview now redirects" 303 (status after); 302 Alcotest.(check string) "to /login" "/login" (location after) ); 303 ] ); 304 ] 305