1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.import", 7 (* The Hevy import web flow, end to end. Each test drives the multipart 8 upload and the review POSTs, then asserts status, redirect location, 9 and Repository state — never rendered HTML. The CSRF token is read from 10 the profile page body, as a browser would. *) 11 let header = 12 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n" 13 in 14 (* One native row. Datetimes are Hevy local wall time. *) 15 let row ~title ~exercise ~set_type ~weight ~reps ?(set_index = 0) 16 ?(start = "01 Jan 2024, 10:00") ?(finish = "01 Jan 2024, 11:00") () = 17 Printf.sprintf "%s,%S,%S,,%s,,,%d,%s,%s,%d,,,\r\n" title start finish 18 exercise set_index set_type weight reps 19 in 20 let csv rows = header ^ String.concat "" rows in 21 (* Register, then read a CSRF token from the profile page. *) 22 let signed_in_profile_token c = 23 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 24 Option.get (csrf_token (body (get c "/profile"))) 25 in 26 let review_token c url = Option.get (csrf_token (body (get c url))) in 27 let batches repo trainee = 28 Lwt_main.run (Test_repo.import_batches repo trainee.Trainee.id) 29 in 30 let imported repo trainee = 31 Lwt_main.run (Test_repo.imported_records repo trainee.Trainee.id) 32 in 33 [ 34 ( "a valid native export uploads to a stored batch with immutable source", 35 `Quick, 36 fun () -> 37 let c, repo = client_with_repo ~import_open:true () in 38 let token = signed_in_profile_token c in 39 let trainee = the_trainee repo ~username:"lifter" in 40 let source = 41 csv 42 [ 43 row ~title:"Legs" ~exercise:"Barbell Squat" 44 ~set_type:"failure" ~weight:"100" ~reps:8 (); 45 ] 46 in 47 let response = 48 post_multipart c "/profile/import" 49 ~file:(Some ("csv", "workouts.csv", source)) 50 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 51 in 52 Alcotest.(check int) "303 to review" 303 (status response); 53 Alcotest.(check bool) 54 "redirects to the review URL" true 55 (index_from ~needle:"/profile/import/" (location response) 0 56 |> Option.is_some); 57 let stored = batches repo trainee in 58 Alcotest.(check int) "one batch stored" 1 (List.length stored); 59 Alcotest.(check string) 60 "source retained verbatim" source 61 (Workout_import.batch_source (List.hd stored)) ); 62 ( "a duplicate upload is refused, the override stores a second batch", 63 `Quick, 64 fun () -> 65 let c, repo = client_with_repo ~import_open:true () in 66 let token = signed_in_profile_token c in 67 let trainee = the_trainee repo ~username:"lifter" in 68 let source = 69 csv 70 [ 71 row ~title:"Legs" ~exercise:"Barbell Squat" 72 ~set_type:"failure" ~weight:"100" ~reps:8 (); 73 ] 74 in 75 let upload ?(allow = false) () = 76 let token = Option.get (csrf_token (body (get c "/profile"))) in 77 let fields = 78 [ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 79 @ if allow then [ ("allow_duplicate", "true") ] else [] 80 in 81 post_multipart c "/profile/import" 82 ~file:(Some ("csv", "workouts.csv", source)) 83 ~fields 84 in 85 ignore token; 86 let first = upload () in 87 Alcotest.(check int) "first upload 303" 303 (status first); 88 let second = upload () in 89 Alcotest.(check int) 90 "duplicate redirects to profile" 303 (status second); 91 Alcotest.(check string) 92 "duplicate lands on profile" "/profile" (location second); 93 Alcotest.(check int) 94 "still one batch after duplicate" 1 95 (List.length (batches repo trainee)); 96 let overridden = upload ~allow:true () in 97 Alcotest.(check int) "override 303" 303 (status overridden); 98 let stored = batches repo trainee in 99 Alcotest.(check int) 100 "override stores a second batch" 2 (List.length stored); 101 (* The two batches have distinct ids, so the override did not 102 overwrite the original. *) 103 let ids = 104 List.map 105 (fun b -> 106 Workout_import.batch_id_to_string 107 (Workout_import.batch_identity b)) 108 stored 109 in 110 Alcotest.(check bool) 111 "the two batch ids differ" true 112 (match ids with [ a; b ] -> a <> b | _ -> false) ); 113 ( "warmup and unsupported rows persist as warnings, not sets", 114 `Quick, 115 fun () -> 116 let c, repo = client_with_repo ~import_open:true () in 117 let token = signed_in_profile_token c in 118 let trainee = the_trainee repo ~username:"lifter" in 119 let source = 120 csv 121 [ 122 row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"warmup" 123 ~weight:"40" ~reps:10 ~set_index:0 (); 124 row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"wibble" 125 ~weight:"50" ~reps:10 ~set_index:1 (); 126 row ~title:"Legs" ~exercise:"Barbell Squat" 127 ~set_type:"failure" ~weight:"100" ~reps:8 ~set_index:2 (); 128 ] 129 in 130 let response = 131 post_multipart c "/profile/import" 132 ~file:(Some ("csv", "workouts.csv", source)) 133 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 134 in 135 Alcotest.(check int) "303 to review" 303 (status response); 136 let batch = List.hd (batches repo trainee) in 137 (* Two warnings: the warmup and the unknown set type. *) 138 Alcotest.(check int) 139 "two rows dropped as warnings" 2 140 (List.length (Workout_import.batch_warnings batch)); 141 (* The workout keeps only the one failure set; no provisional set 142 was invented for the dropped rows. *) 143 let w = List.hd (Workout_import.batch_workouts batch) in 144 Alcotest.(check int) 145 "only the failure set survives" 1 146 (List.length (Workout_import.workout_sets w)) ); 147 ( "map, confirm, then promote writes an imported record", 148 `Quick, 149 fun () -> 150 let c, repo = client_with_repo ~import_open:true () in 151 let token = signed_in_profile_token c in 152 let trainee = the_trainee repo ~username:"lifter" in 153 (* A single normal set: it needs both a mapping and a normal-set 154 confirmation before it can promote. *) 155 let source = 156 csv 157 [ 158 row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"normal" 159 ~weight:"100" ~reps:8 (); 160 ] 161 in 162 let _ = 163 post_multipart c "/profile/import" 164 ~file:(Some ("csv", "workouts.csv", source)) 165 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 166 in 167 let batch = List.hd (batches repo trainee) in 168 let bid = 169 Workout_import.batch_id_to_string 170 (Workout_import.batch_identity batch) 171 in 172 let wid = 173 Workout_import.workout_id_to_string 174 (Workout_import.workout_identity 175 (List.hd (Workout_import.batch_workouts batch))) 176 in 177 let review = "/profile/import/" ^ bid in 178 let map_url = 179 Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid 180 in 181 let t = review_token c review in 182 let _ = 183 post c map_url 184 [ 185 ("dream.csrf", t); 186 ("source_name", "Barbell Squat"); 187 ("exercise_id", "squats"); 188 ] 189 in 190 let t = review_token c review in 191 let confirm_url = 192 Printf.sprintf "/profile/import/%s/workouts/%s/confirm" bid wid 193 in 194 let _ = 195 post c confirm_url 196 [ ("dream.csrf", t); ("acknowledgement", "clean form") ] 197 in 198 let t = review_token c review in 199 let promote_url = 200 Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid 201 in 202 let promote = post c promote_url [ ("dream.csrf", t) ] in 203 Alcotest.(check int) "promotion redirects" 303 (status promote); 204 Alcotest.(check int) 205 "one imported record exists" 1 206 (List.length (imported repo trainee)) ); 207 ( "a dropset-only workout promotes nothing, writing no record", 208 `Quick, 209 fun () -> 210 (* A drop set is discarded on import — HD1 keeps only the drive to 211 failure. A workout of nothing but a drop set therefore has no 212 promotable set and writes no record. *) 213 let c, repo = client_with_repo ~import_open:true () in 214 let token = signed_in_profile_token c in 215 let trainee = the_trainee repo ~username:"lifter" in 216 let source = 217 csv 218 [ 219 row ~title:"Legs" ~exercise:"Barbell Squat" 220 ~set_type:"dropset" ~weight:"100" ~reps:8 (); 221 ] 222 in 223 let _ = 224 post_multipart c "/profile/import" 225 ~file:(Some ("csv", "workouts.csv", source)) 226 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 227 in 228 let batch = List.hd (batches repo trainee) in 229 let bid = 230 Workout_import.batch_id_to_string 231 (Workout_import.batch_identity batch) 232 in 233 let wid = 234 Workout_import.workout_id_to_string 235 (Workout_import.workout_identity 236 (List.hd (Workout_import.batch_workouts batch))) 237 in 238 let review = "/profile/import/" ^ bid in 239 (* Even mapping the discarded set's exercise cannot make it promote. *) 240 let t = review_token c review in 241 let _ = 242 post c 243 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid) 244 [ 245 ("dream.csrf", t); 246 ("source_name", "Barbell Squat"); 247 ("exercise_id", "squats"); 248 ] 249 in 250 let t = review_token c review in 251 let promote = 252 post c 253 (Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid) 254 [ ("dream.csrf", t) ] 255 in 256 Alcotest.(check int) "still a redirect" 303 (status promote); 257 Alcotest.(check int) 258 "no record written for a dropset-only workout" 0 259 (List.length (imported repo trainee)) ); 260 ( "a partial batch promotion promotes the eligible sibling and retains \ 261 the blocked one", 262 `Quick, 263 fun () -> 264 let c, repo = client_with_repo ~import_open:true () in 265 let token = signed_in_profile_token c in 266 let trainee = the_trainee repo ~username:"lifter" in 267 (* Two workouts: one ready failure set, one dropset-only workout 268 that promotes nothing once its drop set is discarded. *) 269 let source = 270 csv 271 [ 272 row ~title:"Legs" ~exercise:"Barbell Squat" 273 ~set_type:"failure" ~weight:"100" ~reps:8 274 ~start:"01 Jan 2024, 10:00" ~finish:"01 Jan 2024, 11:00" (); 275 row ~title:"Arms" ~exercise:"Barbell Curl" ~set_type:"dropset" 276 ~weight:"30" ~reps:8 ~start:"02 Jan 2024, 10:00" 277 ~finish:"02 Jan 2024, 11:00" (); 278 ] 279 in 280 let _ = 281 post_multipart c "/profile/import" 282 ~file:(Some ("csv", "workouts.csv", source)) 283 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 284 in 285 let batch = List.hd (batches repo trainee) in 286 let bid = 287 Workout_import.batch_id_to_string 288 (Workout_import.batch_identity batch) 289 in 290 let review = "/profile/import/" ^ bid in 291 (* Map the ready workout's exercise so its only blocker clears. *) 292 let ready_wid = 293 List.find_map 294 (fun w -> 295 if String.equal (Workout_import.workout_title w) "Legs" then 296 Some 297 (Workout_import.workout_id_to_string 298 (Workout_import.workout_identity w)) 299 else None) 300 (Workout_import.batch_workouts batch) 301 |> Option.get 302 in 303 let t = review_token c review in 304 let _ = 305 post c 306 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid 307 ready_wid) 308 [ 309 ("dream.csrf", t); 310 ("source_name", "Barbell Squat"); 311 ("exercise_id", "squats"); 312 ] 313 in 314 let t = review_token c review in 315 let promote = 316 post c 317 (Printf.sprintf "/profile/import/%s/promote" bid) 318 [ ("dream.csrf", t) ] 319 in 320 Alcotest.(check int) 321 "batch promotion redirects" 303 (status promote); 322 (* Only the eligible sibling is promoted. The dropset-only workout 323 has nothing to promote, writes no record, and stays in the 324 batch. *) 325 Alcotest.(check int) 326 "one record from the eligible sibling" 1 327 (List.length (imported repo trainee)) ); 328 ( "an unknown batch GET is 404, an unknown exercise mapping changes \ 329 nothing", 330 `Quick, 331 fun () -> 332 let c, repo = client_with_repo ~import_open:true () in 333 let token = signed_in_profile_token c in 334 let trainee = the_trainee repo ~username:"lifter" in 335 (* Unknown batch id: the review GET is a 404. *) 336 ignore token; 337 Alcotest.(check int) 338 "unknown batch review is 404" 404 339 (status (get c "/profile/import/no-such-batch")); 340 (* Upload a real batch, then map to an id absent from the catalog. 341 No mapping is recorded. *) 342 let source = 343 csv 344 [ 345 row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"normal" 346 ~weight:"100" ~reps:8 (); 347 ] 348 in 349 let up_token = Option.get (csrf_token (body (get c "/profile"))) in 350 let _ = 351 post_multipart c "/profile/import" 352 ~file:(Some ("csv", "workouts.csv", source)) 353 ~fields: 354 [ ("dream.csrf", up_token); ("utc_offset_seconds", "0") ] 355 in 356 let batch = List.hd (batches repo trainee) in 357 let bid = 358 Workout_import.batch_id_to_string 359 (Workout_import.batch_identity batch) 360 in 361 let wid = 362 Workout_import.workout_id_to_string 363 (Workout_import.workout_identity 364 (List.hd (Workout_import.batch_workouts batch))) 365 in 366 let review = "/profile/import/" ^ bid in 367 let t = review_token c review in 368 let response = 369 post c 370 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid) 371 [ 372 ("dream.csrf", t); 373 ("source_name", "Barbell Squat"); 374 ("exercise_id", "not-an-exercise"); 375 ] 376 in 377 Alcotest.(check int) 378 "unknown exercise redirects, not errors" 303 (status response); 379 (* The stored workout still has no mapping for the source name. *) 380 let reloaded = List.hd (batches repo trainee) in 381 let w = List.hd (Workout_import.batch_workouts reloaded) in 382 Alcotest.(check bool) 383 "no mapping was recorded" true 384 (Option.is_none 385 (Workout_import.workout_mapping w ~source_name:"Barbell Squat")) 386 ); 387 ] ); 388 ] 389