1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.isolation", 7 [ 8 ( "two trainees never share workout or logbook state", 9 `Quick, 10 fun () -> 11 (* Two trainees on the same store, each with their own cookie jar. 12 One begins and finishes a workout; the other must see none of it: 13 not the in-progress workout, not the saved record. This proves 14 the per-trainee scoping the service promises, over HTTP. *) 15 let alice, repo = client_with_repo () in 16 let _ = register alice ~username:"alice" ~password:"heavyduty1" in 17 let bob = { alice with jar = [] } in 18 let _ = register bob ~username:"bobby" ~password:"heavyduty1" in 19 let alice_t = the_trainee repo ~username:"alice" in 20 let bob_t = the_trainee repo ~username:"bobby" in 21 (* Alice selects and begins a workout, records a slot. *) 22 let token = Option.get (csrf_token (body (get alice "/"))) in 23 let _ = 24 post alice "/routines/ideal/select" [ ("dream.csrf", token) ] 25 in 26 let token = Option.get (csrf_token (body (get alice "/"))) in 27 let _ = 28 post alice "/workout" 29 [ ("dream.csrf", token); ("override", "false") ] 30 in 31 let token = 32 Option.get (csrf_token (body (get alice "/workout?slot=1"))) 33 in 34 let _ = 35 post alice "/workout/slots/1" 36 [ 37 ("dream.csrf", token); 38 ("load", "12"); 39 ("reps", "8"); 40 ("extension", ""); 41 ] 42 in 43 (* Alice has a workout in progress; Bob does not. *) 44 Alcotest.(check bool) 45 "Alice has a workout in progress" true 46 (Option.is_some 47 (Lwt_main.run (Test_repo.in_progress repo alice_t.Trainee.id))); 48 Alcotest.(check bool) 49 "Bob has no workout in progress" true 50 (Option.is_none 51 (Lwt_main.run (Test_repo.in_progress repo bob_t.Trainee.id))); 52 Alcotest.(check int) 53 "Bob's workout view redirects" 303 54 (status (get bob "/workout")); 55 (* Alice finishes; her record becomes t1:w1 for her. *) 56 let token = Option.get (csrf_token (body (get alice "/workout"))) in 57 let _ = post alice "/workout/finish" [ ("dream.csrf", token) ] in 58 Alcotest.(check int) 59 "Alice has one saved workout" 1 60 (List.length 61 (Lwt_main.run (Test_repo.history repo alice_t.Trainee.id))); 62 Alcotest.(check int) 63 "Alice sees her saved workout" 200 64 (status (get alice "/logbook/t1:w1")); 65 (* Bob's history is empty, and Alice's record is unreachable from 66 Bob's session. The stored identity names Alice, so it does not 67 exist. *) 68 Alcotest.(check int) 69 "Bob's history is empty" 0 70 (List.length 71 (Lwt_main.run (Test_repo.history repo bob_t.Trainee.id))); 72 Alcotest.(check int) 73 "Bob cannot open a record he does not own" 404 74 (status (get bob "/logbook/t1:w1")) ); 75 ] ); 76 ] 77