1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.app_feedback", 7 [ 8 ( "the app feedback screen and its tabs are served", 9 `Quick, 10 fun () -> 11 let c = client () in 12 let _ = sign_in_new c in 13 Alcotest.(check int) 14 "write tab served" 200 15 (status (get c "/app-feedback")); 16 Alcotest.(check int) 17 "submitted tab served" 200 18 (status (get c "/app-feedback?tab=submitted")) ); 19 ( "blank app feedback is refused; a real message is stored", 20 `Quick, 21 fun () -> 22 let c, repo = client_with_repo () in 23 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 24 let trainee = the_trainee repo ~username:"lifter" in 25 let stored_count () = 26 List.length 27 (Lwt_main.run 28 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id)) 29 in 30 let token = 31 Option.get (csrf_token (body (get c "/app-feedback"))) 32 in 33 let blank = 34 post c "/app-feedback/submit" 35 [ ("dream.csrf", token); ("message", " ") ] 36 in 37 Alcotest.(check int) "blank message redirects" 303 (status blank); 38 Alcotest.(check bool) 39 "redirects to the write tab" true 40 (List.mem "/app-feedback?tab=write" 41 (Dream.headers blank "Location")); 42 (* Blank input stored nothing. *) 43 Alcotest.(check int) 44 "no report stored for blank input" 0 (stored_count ()); 45 let token = 46 Option.get (csrf_token (body (get c "/app-feedback"))) 47 in 48 let submitted = 49 post c "/app-feedback/submit" 50 [ 51 ("dream.csrf", token); 52 ("message", "The app is clear.\nThank you!"); 53 ] 54 in 55 Alcotest.(check int) "message is accepted" 303 (status submitted); 56 Alcotest.(check bool) 57 "redirects to submitted feedback" true 58 (List.mem "/app-feedback?tab=submitted" 59 (Dream.headers submitted "Location")); 60 (* The report now exists with the exact message. *) 61 let reports = 62 Lwt_main.run 63 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id) 64 in 65 Alcotest.(check int) "one report stored" 1 (List.length reports); 66 Alcotest.(check string) 67 "stores the exact message" "The app is clear.\nThank you!" 68 (List.hd reports).Repository.message ); 69 ( "feedback records its author and accepts another trainee's vote", 70 `Quick, 71 fun () -> 72 let alice = client () in 73 let _ = register alice ~username:"alice" ~password:"heavyduty1" in 74 let bob = { alice with jar = [] } in 75 let _ = register bob ~username:"bobby" ~password:"heavyduty1" in 76 let submit client message = 77 let token = 78 Option.get (csrf_token (body (get client "/app-feedback"))) 79 in 80 post client "/app-feedback/submit" 81 [ ("dream.csrf", token); ("message", message) ] 82 in 83 Alcotest.(check int) 84 "alice feedback accepted" 303 85 (status (submit alice "Alice report")); 86 Alcotest.(check int) 87 "bob feedback accepted" 303 88 (status (submit bob "Bob report")); 89 (* Bob's report is t2:1 — the vote control on Alice's view posts 90 there. Alice upvotes it. *) 91 let list_page = body (get alice "/app-feedback?tab=submitted") in 92 let token = Option.get (csrf_token list_page) in 93 let voted = 94 post alice "/app-feedback/t2:1/upvote" [ ("dream.csrf", token) ] 95 in 96 Alcotest.(check int) "upvote redirects" 303 (status voted) ); 97 ( "an owner can edit and remove their feedback", 98 `Quick, 99 fun () -> 100 let c, repo = client_with_repo () in 101 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 102 let trainee = the_trainee repo ~username:"lifter" in 103 let token = 104 Option.get (csrf_token (body (get c "/app-feedback"))) 105 in 106 let _ = 107 post c "/app-feedback/submit" 108 [ ("dream.csrf", token); ("message", "First report") ] 109 in 110 let feedback_id () = 111 (List.hd 112 (Lwt_main.run 113 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id))) 114 .Repository.feedback_id |> Repository.app_feedback_id_to_string 115 in 116 let id = feedback_id () in 117 (* A blank edit is refused and changes nothing. *) 118 let token = 119 Option.get 120 (csrf_token (body (get c "/app-feedback?tab=submitted"))) 121 in 122 let blank = 123 post c 124 ("/app-feedback/" ^ id ^ "/edit") 125 [ ("dream.csrf", token); ("message", " ") ] 126 in 127 Alcotest.(check int) "blank edit redirects" 303 (status blank); 128 Alcotest.(check string) 129 "message unchanged by blank edit" "First report" 130 (List.hd 131 (Lwt_main.run 132 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id))) 133 .Repository.message; 134 (* A real edit changes the stored message. *) 135 let token = 136 Option.get 137 (csrf_token (body (get c "/app-feedback?tab=submitted"))) 138 in 139 let edited = 140 post c 141 ("/app-feedback/" ^ id ^ "/edit") 142 [ ("dream.csrf", token); ("message", "Edited report") ] 143 in 144 Alcotest.(check int) "edit redirects" 303 (status edited); 145 Alcotest.(check string) 146 "message updated by edit" "Edited report" 147 (List.hd 148 (Lwt_main.run 149 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id))) 150 .Repository.message; 151 (* Removal deletes the report. *) 152 let token = 153 Option.get 154 (csrf_token (body (get c "/app-feedback?tab=submitted"))) 155 in 156 let removed = 157 post c 158 ("/app-feedback/" ^ id ^ "/remove") 159 [ ("dream.csrf", token) ] 160 in 161 Alcotest.(check int) "remove redirects" 303 (status removed); 162 Alcotest.(check int) 163 "report removed" 0 164 (List.length 165 (Lwt_main.run 166 (Test_repo.app_feedback repo ~viewer:trainee.Trainee.id))) 167 ); 168 ( "another trainee cannot edit or remove app feedback", 169 `Quick, 170 fun () -> 171 let alice, repo = client_with_repo () in 172 let _ = register alice ~username:"alice" ~password:"heavyduty1" in 173 let bob = { alice with jar = [] } in 174 let _ = register bob ~username:"bobby" ~password:"heavyduty1" in 175 let bob_trainee = the_trainee repo ~username:"bobby" in 176 (* Bob owns t2:1. Alice attempts to edit and remove it. Both are 177 refused at the ownership check, so the report and its message 178 survive. *) 179 let token = 180 Option.get (csrf_token (body (get bob "/app-feedback"))) 181 in 182 let _ = 183 post bob "/app-feedback/submit" 184 [ ("dream.csrf", token); ("message", "Bob owns this") ] 185 in 186 let stored () = 187 Lwt_main.run 188 (Test_repo.app_feedback repo ~viewer:bob_trainee.Trainee.id) 189 in 190 Alcotest.(check int) 191 "one report before cross-user attempts" 1 192 (List.length (stored ())); 193 let token = 194 Option.get 195 (csrf_token (body (get alice "/app-feedback?tab=submitted"))) 196 in 197 let edited = 198 post alice "/app-feedback/t2:1/edit" 199 [ ("dream.csrf", token); ("message", "Taken over") ] 200 in 201 Alcotest.(check int) "cross-user edit redirects" 303 (status edited); 202 let token = 203 Option.get 204 (csrf_token (body (get alice "/app-feedback?tab=submitted"))) 205 in 206 let removed = 207 post alice "/app-feedback/t2:1/remove" [ ("dream.csrf", token) ] 208 in 209 Alcotest.(check int) 210 "cross-user remove redirects" 303 (status removed); 211 (* The report still exists with its original message: the cross-user 212 attempts changed nothing. *) 213 let after = stored () in 214 Alcotest.(check int) 215 "report survives cross-user attempts" 1 (List.length after); 216 Alcotest.(check string) 217 "message is unchanged" "Bob owns this" 218 (List.hd after).Repository.message ); 219 ] ); 220 ] 221