[OCaml] High Intensity Training Online
feat Add the Hevy import review flow
Add authenticated profile upload and review routes for native Hevy CSV exports. Users can review warnings, confirm every exercise mapping, acknowledge all normal sets at workout scope, promote one workout, or promote every eligible workout in a batch. Duplicate uploads require an explicit override. Blocked workouts remain provisional while eligible siblings promote independently.
Changed files
lib/web/handlers.ml
@@ -1229,6 +1229,307 @@
1229
1229
]
1230
1230
end
1231
1231
1232
Added:
module Import = struct
1233
Added:
let max_source_bytes = 10 * 1024 * 1024
1234
Added:
1235
Added:
(* Phrase an adapter warning for the view. The controller owns the wording,
1236
Added:
so no warning variant crosses into the presenter. *)
1237
Added:
let warning_view (w : Workout_import.warning) : View_model.Import_warning.t
1238
Added:
=
1239
Added:
let detail =
1240
Added:
match w.Workout_import.kind with
1241
Added:
| Workout_import.Warmup_dropped -> "warmup set dropped"
1242
Added:
| Workout_import.Unsupported_row reason -> reason
1243
Added:
in
1244
Added:
{ row = w.Workout_import.row; detail }
1245
Added:
1246
Added:
let set_type_string : Workout_import.source_set_type -> string = function
1247
Added:
| Workout_import.Normal -> "normal"
1248
Added:
| Workout_import.Failure -> "failure"
1249
Added:
| Workout_import.Dropset -> "dropset"
1250
Added:
1251
Added:
(* Phrase one promotion blocker for the view. *)
1252
Added:
let blocker_string : Workout_import.blocker -> string = function
1253
Added:
| Workout_import.No_sets -> "The workout has no promotable sets."
1254
Added:
| Workout_import.Dropset_present rows ->
1255
Added:
Printf.sprintf "Drop sets cannot be promoted (rows %s)."
1256
Added:
(String.concat ", " (List.map string_of_int rows))
1257
Added:
| Workout_import.Unmapped_exercise name ->
1258
Added:
Printf.sprintf "The exercise %S is not mapped to a catalog entry."
1259
Added:
name
1260
Added:
| Workout_import.Normal_sets_unconfirmed ->
1261
Added:
"The normal sets need a confirmation acknowledgement."
1262
Added:
1263
Added:
let set_view workout (s : Workout_import.source_set) :
1264
Added:
View_model.Import_set.t =
1265
Added:
let mapping =
1266
Added:
Workout_import.workout_mapping workout
1267
Added:
~source_name:s.Workout_import.exercise_name
1268
Added:
|> Option.map Exercise.name
1269
Added:
in
1270
Added:
{
1271
Added:
row = s.Workout_import.row;
1272
Added:
exercise_name = s.Workout_import.exercise_name;
1273
Added:
set_type = set_type_string s.Workout_import.set_type;
1274
Added:
weight = Printf.sprintf "%g" s.Workout_import.weight_kg;
1275
Added:
reps = string_of_int s.Workout_import.reps;
1276
Added:
mapping;
1277
Added:
}
1278
Added:
1279
Added:
let workout_view (workout : Workout_import.workout) :
1280
Added:
View_model.Import_workout.t =
1281
Added:
{
1282
Added:
id =
1283
Added:
Workout_import.workout_id_to_string
1284
Added:
(Workout_import.workout_identity workout);
1285
Added:
title = Workout_import.workout_title workout;
1286
Added:
sets = List.map (set_view workout) (Workout_import.workout_sets workout);
1287
Added:
blockers = List.map blocker_string (Workout_import.blockers workout);
1288
Added:
acknowledgement = Workout_import.workout_acknowledgement workout;
1289
Added:
revision = Workout_import.workout_revision workout;
1290
Added:
}
1291
Added:
1292
Added:
let review_view (batch : Workout_import.batch) : View_model.Import_review.t
1293
Added:
=
1294
Added:
{
1295
Added:
batch_id =
1296
Added:
Workout_import.batch_id_to_string
1297
Added:
(Workout_import.batch_identity batch);
1298
Added:
warnings = List.map warning_view (Workout_import.batch_warnings batch);
1299
Added:
workouts = List.map workout_view (Workout_import.batch_workouts batch);
1300
Added:
}
1301
Added:
1302
Added:
let viewer_of (trainee : Trainee.t) =
1303
Added:
{
1304
Added:
View_model.Viewer.username = Trainee.username_to_string trainee.username;
1305
Added:
}
1306
Added:
1307
Added:
(* A distinct batch id even when a duplicate override re-imports the same
1308
Added:
source: the fingerprint prefix, the import time in seconds, and a random
1309
Added:
suffix keep two imports of one export apart, so an override never
1310
Added:
overwrites the original batch. *)
1311
Added:
let generate_batch_id ~fingerprint ~imported_at =
1312
Added:
let prefix =
1313
Added:
String.sub fingerprint 0 (min 8 (String.length fingerprint))
1314
Added:
in
1315
Added:
let seconds = Recovery.timestamp_to_unix_seconds imported_at in
1316
Added:
let suffix = Dream.to_base64url (Dream.random 6) in
1317
Added:
Printf.sprintf "%s-%d-%s" prefix seconds suffix
1318
Added:
1319
Added:
(* Extract the single CSV file and the offset from a verified multipart
1320
Added:
form. Dream verifies the CSRF token, so a bad token never reaches here. *)
1321
Added:
let read_upload request =
1322
Added:
Dream.multipart ~csrf:true request >|= function
1323
Added:
| `Ok fields -> (
1324
Added:
let csv =
1325
Added:
match List.assoc_opt "csv" fields with
1326
Added:
| Some ((_, content) :: _) -> Some content
1327
Added:
| _ -> None
1328
Added:
in
1329
Added:
let offset =
1330
Added:
match List.assoc_opt "utc_offset_seconds" fields with
1331
Added:
| Some ((_, raw) :: _) -> int_of_string_opt (String.trim raw)
1332
Added:
| _ -> None
1333
Added:
in
1334
Added:
let allow_duplicate =
1335
Added:
match List.assoc_opt "allow_duplicate" fields with
1336
Added:
| Some ((_, "true") :: _) -> true
1337
Added:
| _ -> false
1338
Added:
in
1339
Added:
match (csv, offset) with
1340
Added:
| Some source, Some offset -> Ok (source, offset, allow_duplicate)
1341
Added:
| _ -> Error `Bad_request)
1342
Added:
| _ -> Error `Bad_request
1343
Added:
1344
Added:
let upload t trainee request =
1345
Added:
read_upload request >>= function
1346
Added:
| Error `Bad_request ->
1347
Added:
redirect_with_flash request Routes.profile
1348
Added:
"The import upload is missing its file or offset."
1349
Added:
| Ok (source, _, _) when String.length source > max_source_bytes ->
1350
Added:
redirect_with_flash request Routes.profile
1351
Added:
"The import file exceeds the 10 MiB limit."
1352
Added:
| Ok (source, utc_offset_seconds, allow_duplicate) -> (
1353
Added:
let fingerprint = Digest.to_hex (Digest.string source) in
1354
Added:
let imported_at = t.now () in
1355
Added:
let batch_id =
1356
Added:
Workout_import.batch_id
1357
Added:
(generate_batch_id ~fingerprint ~imported_at)
1358
Added:
in
1359
Added:
match
1360
Added:
Hevy_csv.parse ~batch_id ~fingerprint ~imported_at
1361
Added:
~utc_offset_seconds source
1362
Added:
with
1363
Added:
| Error e ->
1364
Added:
redirect_with_flash request Routes.profile
1365
Added:
(Format.asprintf "%a" Hevy_csv.pp_error e)
1366
Added:
| Ok batch -> (
1367
Added:
let allow_duplicate = if allow_duplicate then Some () else None in
1368
Added:
Service.store_import_batch t.service trainee.Trainee.id
1369
Added:
?allow_duplicate batch
1370
Added:
>>= function
1371
Added:
| Ok () ->
1372
Added:
redirect_with_flash_attr request
1373
Added:
(Dream_html.path_attr Dream_html.HTML.href
1374
Added:
Routes.import_review
1375
Added:
(Workout_import.batch_id_to_string batch_id))
1376
Added:
"Import stored. Review it below."
1377
Added:
| Error `Duplicate_source ->
1378
Added:
redirect_with_flash request Routes.profile
1379
Added:
"This export was already imported. Re-submit with the \
1380
Added:
duplicate override to import it again."
1381
Added:
| Error _ ->
1382
Added:
redirect_with_flash request Routes.profile
1383
Added:
"The import could not be stored."))
1384
Added:
1385
Added:
let review_target t trainee id =
1386
Added:
Service.find_import_batch t.service trainee (Workout_import.batch_id id)
1387
Added:
1388
Added:
let review_url id =
1389
Added:
Dream_html.path_attr Dream_html.HTML.href Routes.import_review id
1390
Added:
1391
Added:
let review t trainee request id =
1392
Added:
review_target t trainee.Trainee.id id >>= function
1393
Added:
| None -> not_found "That import batch no longer exists."
1394
Added:
| Some batch ->
1395
Added:
html
1396
Added:
(Pages.import_review request ~viewer:(viewer_of trainee)
1397
Added:
(review_view batch))
1398
Added:
1399
Added:
let map t trainee request batch_id workout_id =
1400
Added:
Dream.form request >>= function
1401
Added:
| `Ok fields -> (
1402
Added:
match
1403
Added:
( List.assoc_opt "source_name" fields,
1404
Added:
List.assoc_opt "exercise_id" fields )
1405
Added:
with
1406
Added:
| Some source_name, Some exercise_id -> (
1407
Added:
match Exercise.find_id (String.trim exercise_id) with
1408
Added:
| None ->
1409
Added:
redirect_with_flash_attr request (review_url batch_id)
1410
Added:
"That exercise id is not in the catalogue."
1411
Added:
| Some exercise -> (
1412
Added:
Service.map_import_exercise t.service trainee.Trainee.id
1413
Added:
~batch:(Workout_import.batch_id batch_id)
1414
Added:
~workout:(Workout_import.workout_id workout_id)
1415
Added:
~source_name exercise
1416
Added:
>>= function
1417
Added:
| Ok _ ->
1418
Added:
redirect_with_flash_attr request (review_url batch_id)
1419
Added:
"Exercise mapped."
1420
Added:
| Error `Unknown_batch ->
1421
Added:
not_found "That import batch no longer exists."
1422
Added:
| Error _ ->
1423
Added:
redirect_with_flash_attr request (review_url batch_id)
1424
Added:
"That mapping could not be applied."))
1425
Added:
| _ ->
1426
Added:
redirect_with_flash_attr request (review_url batch_id)
1427
Added:
Present.form_invalid)
1428
Added:
| _ ->
1429
Added:
redirect_with_flash_attr request (review_url batch_id)
1430
Added:
Present.form_invalid
1431
Added:
1432
Added:
let confirm t trainee request batch_id workout_id =
1433
Added:
Dream.form request >>= function
1434
Added:
| `Ok fields -> (
1435
Added:
match List.assoc_opt "acknowledgement" fields with
1436
Added:
| Some acknowledgement -> (
1437
Added:
Service.confirm_import_normal_sets t.service trainee.Trainee.id
1438
Added:
~batch:(Workout_import.batch_id batch_id)
1439
Added:
~workout:(Workout_import.workout_id workout_id)
1440
Added:
~acknowledgement
1441
Added:
>>= function
1442
Added:
| Ok _ ->
1443
Added:
redirect_with_flash_attr request (review_url batch_id)
1444
Added:
"Normal sets confirmed."
1445
Added:
| Error `Unknown_batch ->
1446
Added:
not_found "That import batch no longer exists."
1447
Added:
| Error (`Import Workout_import.Empty_acknowledgement) ->
1448
Added:
redirect_with_flash_attr request (review_url batch_id)
1449
Added:
"Enter an acknowledgement before confirming."
1450
Added:
| Error _ ->
1451
Added:
redirect_with_flash_attr request (review_url batch_id)
1452
Added:
"That confirmation could not be applied.")
1453
Added:
| None ->
1454
Added:
redirect_with_flash_attr request (review_url batch_id)
1455
Added:
Present.form_invalid)
1456
Added:
| _ ->
1457
Added:
redirect_with_flash_attr request (review_url batch_id)
1458
Added:
Present.form_invalid
1459
Added:
1460
Added:
let promote_workout t trainee request batch_id workout_id =
1461
Added:
guard_csrf request >>= function
1462
Added:
| Error _ ->
1463
Added:
redirect_with_flash_attr request (review_url batch_id)
1464
Added:
Present.form_invalid
1465
Added:
| Ok () -> (
1466
Added:
Service.promote_import_workout t.service trainee.Trainee.id
1467
Added:
~batch:(Workout_import.batch_id batch_id)
1468
Added:
~workout:(Workout_import.workout_id workout_id)
1469
Added:
>>= function
1470
Added:
| Ok (Workout_import.Promoted _) ->
1471
Added:
redirect_with_flash_attr request (review_url batch_id)
1472
Added:
"Workout promoted."
1473
Added:
| Ok (Workout_import.Already_promoted _) ->
1474
Added:
redirect_with_flash_attr request (review_url batch_id)
1475
Added:
"Workout was already promoted."
1476
Added:
| Ok (Workout_import.Blocked blockers) ->
1477
Added:
redirect_with_flash_attr request (review_url batch_id)
1478
Added:
(Printf.sprintf "Workout blocked: %s"
1479
Added:
(String.concat " " (List.map blocker_string blockers)))
1480
Added:
| Error `Unknown_batch ->
1481
Added:
not_found "That import batch no longer exists."
1482
Added:
| Error _ ->
1483
Added:
redirect_with_flash_attr request (review_url batch_id)
1484
Added:
"That promotion could not be applied.")
1485
Added:
1486
Added:
let promote_batch t trainee request batch_id =
1487
Added:
guard_csrf request >>= function
1488
Added:
| Error _ ->
1489
Added:
redirect_with_flash_attr request (review_url batch_id)
1490
Added:
Present.form_invalid
1491
Added:
| Ok () -> (
1492
Added:
Service.promote_import_batch t.service trainee.Trainee.id
1493
Added:
~batch:(Workout_import.batch_id batch_id)
1494
Added:
>>= function
1495
Added:
| Ok result ->
1496
Added:
let promoted = List.length result.Workout_import.promoted in
1497
Added:
let already =
1498
Added:
List.length result.Workout_import.already_promoted
1499
Added:
in
1500
Added:
let blocked = List.length result.Workout_import.blocked in
1501
Added:
redirect_with_flash_attr request (review_url batch_id)
1502
Added:
(Printf.sprintf "Promoted %d, already promoted %d, blocked %d."
1503
Added:
promoted already blocked)
1504
Added:
| Error `Unknown_batch ->
1505
Added:
not_found "That import batch no longer exists."
1506
Added:
| Error _ ->
1507
Added:
redirect_with_flash_attr request (review_url batch_id)
1508
Added:
"That promotion could not be applied.")
1509
Added:
1510
Added:
let routes t =
1511
Added:
[
1512
Added:
Dream_html.post Routes.import_upload (fun request ->
1513
Added:
authenticated t request (fun trainee -> upload t trainee request));
1514
Added:
Dream_html.get Routes.import_review (fun request id ->
1515
Added:
authenticated t request (fun trainee -> review t trainee request id));
1516
Added:
Dream_html.post Routes.import_map (fun request batch_id workout_id ->
1517
Added:
authenticated t request (fun trainee ->
1518
Added:
map t trainee request batch_id workout_id));
1519
Added:
Dream_html.post Routes.import_confirm
1520
Added:
(fun request batch_id workout_id ->
1521
Added:
authenticated t request (fun trainee ->
1522
Added:
confirm t trainee request batch_id workout_id));
1523
Added:
Dream_html.post Routes.import_promote_workout
1524
Added:
(fun request batch_id workout_id ->
1525
Added:
authenticated t request (fun trainee ->
1526
Added:
promote_workout t trainee request batch_id workout_id));
1527
Added:
Dream_html.post Routes.import_promote_batch (fun request batch_id ->
1528
Added:
authenticated t request (fun trainee ->
1529
Added:
promote_batch t trainee request batch_id));
1530
Added:
]
1531
Added:
end
1532
Added:
1232
1533
module Assets = struct
1233
1534
let stylesheet =
1234
1535
match Stylesheet.read "hito.css" with
@@ -1266,7 +1567,7 @@
1266
1567
let routes t =
1267
1568
Auth.routes t @ Overview.routes t @ Current_workout.routes t
1268
1569
@ Logbook.routes t @ App_feedback.routes t @ Profile.routes t
1269
Removed:
@ Assets.routes @ [ catch_all ]
1570
Added:
@ Import.routes t @ Assets.routes @ [ catch_all ]
1270
1571
1271
1572
(* A branded error page for every failure Dream routes here: unmatched paths,
1272
1573
[4xx] and [5xx] responses, and uncaught exceptions. The page names only the
lib/web/pages.ml
@@ -1820,4 +1820,226 @@
1820
1820
@ error_block password_error);
1821
1821
];
1822
1822
];
1823
Added:
(* Import: a multipart form uploads a native Hevy CSV export. The file
1824
Added:
field is [csv], the wall-clock offset is [utc_offset_seconds], and an
1825
Added:
optional checkbox overrides duplicate-source rejection. The form is a
1826
Added:
plain multipart POST with its CSRF token, so it needs no script. *)
1827
Added:
tag "section"
1828
Added:
[ class_ "profile-section" ]
1829
Added:
[
1830
Added:
tag "h2" [] [ txt "Import" ];
1831
Added:
tag "form"
1832
Added:
[
1833
Added:
action Routes.import_upload;
1834
Added:
post_form;
1835
Added:
Dream_html.string_attr "enctype" "multipart/form-data";
1836
Added:
class_ "profile-form";
1837
Added:
]
1838
Added:
[
1839
Added:
Dream_html.csrf_tag request;
1840
Added:
tag "div"
1841
Added:
[ class_ "field" ]
1842
Added:
[
1843
Added:
tag "label"
1844
Added:
[ Dream_html.string_attr "for" "csv" ]
1845
Added:
[ txt "Hevy CSV export" ];
1846
Added:
void "input"
1847
Added:
[
1848
Added:
type_ "file";
1849
Added:
name "csv";
1850
Added:
Dream_html.string_attr "id" "csv";
1851
Added:
Dream_html.string_attr "accept" ".csv,text/csv";
1852
Added:
required;
1853
Added:
];
1854
Added:
];
1855
Added:
tag "div"
1856
Added:
[ class_ "field" ]
1857
Added:
[
1858
Added:
tag "label"
1859
Added:
[ Dream_html.string_attr "for" "utc_offset_seconds" ]
1860
Added:
[ txt "UTC offset in seconds" ];
1861
Added:
void "input"
1862
Added:
[
1863
Added:
type_ "number";
1864
Added:
name "utc_offset_seconds";
1865
Added:
Dream_html.string_attr "id" "utc_offset_seconds";
1866
Added:
Dream_html.string_attr "value" "0";
1867
Added:
required;
1868
Added:
];
1869
Added:
];
1870
Added:
tag "div"
1871
Added:
[ class_ "field" ]
1872
Added:
[
1873
Added:
void "input"
1874
Added:
[
1875
Added:
type_ "checkbox";
1876
Added:
name "allow_duplicate";
1877
Added:
Dream_html.string_attr "id" "allow_duplicate";
1878
Added:
value "true";
1879
Added:
];
1880
Added:
tag "label"
1881
Added:
[ Dream_html.string_attr "for" "allow_duplicate" ]
1882
Added:
[ txt "Import even if this export was imported before" ];
1883
Added:
];
1884
Added:
void "input" [ type_ "submit"; value "Upload import" ];
1885
Added:
];
1886
Added:
];
1823
1887
])
1888
Added:
1889
Added:
(* The review of a provisional import batch. It renders the parse warnings, then
1890
Added:
each workout with its sets, blockers, and forms. Every form is a plain POST
1891
Added:
carrying its CSRF token, so cleaning and promotion need no script. The page
1892
Added:
names only the view model: the controller has already phrased set types,
1893
Added:
blockers, and warnings, so no core entity crosses the boundary here. *)
1894
Added:
let import_review request ~viewer (vm : View_model.Import_review.t) =
1895
Added:
let warnings_block =
1896
Added:
match vm.View_model.Import_review.warnings with
1897
Added:
| [] -> []
1898
Added:
| warnings ->
1899
Added:
[
1900
Added:
tag "section"
1901
Added:
[ class_ "import-warnings" ]
1902
Added:
[
1903
Added:
tag "h2" [] [ txt "Dropped rows" ];
1904
Added:
tag "ul" []
1905
Added:
(List.map
1906
Added:
(fun (w : View_model.Import_warning.t) ->
1907
Added:
tag "li" []
1908
Added:
[
1909
Added:
txt "Row %d: %s" w.View_model.Import_warning.row
1910
Added:
w.View_model.Import_warning.detail;
1911
Added:
])
1912
Added:
warnings);
1913
Added:
];
1914
Added:
]
1915
Added:
in
1916
Added:
(* One row per set. A mapped set shows the catalog name it resolves to. *)
1917
Added:
let set_row (s : View_model.Import_set.t) =
1918
Added:
let mapping =
1919
Added:
match s.View_model.Import_set.mapping with
1920
Added:
| Some name -> Printf.sprintf " → %s" name
1921
Added:
| None -> " → unmapped"
1922
Added:
in
1923
Added:
tag "li" []
1924
Added:
[
1925
Added:
txt "Row %d: %s (%s) %s kg × %s reps%s" s.View_model.Import_set.row
1926
Added:
s.View_model.Import_set.exercise_name s.View_model.Import_set.set_type
1927
Added:
s.View_model.Import_set.weight s.View_model.Import_set.reps mapping;
1928
Added:
]
1929
Added:
in
1930
Added:
(* One mapping form per distinct source name in the workout. The source name
1931
Added:
is fixed by a hidden field; the trainee supplies the catalog exercise id. *)
1932
Added:
let mapping_form batch_id workout_id source_name =
1933
Added:
tag "form"
1934
Added:
[
1935
Added:
action Routes.import_map batch_id workout_id;
1936
Added:
post_form;
1937
Added:
class_ "import-map-form";
1938
Added:
]
1939
Added:
[
1940
Added:
Dream_html.csrf_tag request;
1941
Added:
void "input"
1942
Added:
[
1943
Added:
type_ "hidden";
1944
Added:
name "source_name";
1945
Added:
Dream_html.string_attr "value" "%s" source_name;
1946
Added:
];
1947
Added:
tag "div"
1948
Added:
[ class_ "field" ]
1949
Added:
[
1950
Added:
tag "label" [] [ txt "Map %s to exercise id" source_name ];
1951
Added:
void "input" [ type_ "text"; name "exercise_id"; required ];
1952
Added:
];
1953
Added:
void "input" [ type_ "submit"; value "Map exercise" ];
1954
Added:
]
1955
Added:
in
1956
Added:
let confirm_form batch_id workout_id acknowledgement =
1957
Added:
tag "form"
1958
Added:
[
1959
Added:
action Routes.import_confirm batch_id workout_id;
1960
Added:
post_form;
1961
Added:
class_ "import-confirm-form";
1962
Added:
]
1963
Added:
[
1964
Added:
Dream_html.csrf_tag request;
1965
Added:
tag "div"
1966
Added:
[ class_ "field" ]
1967
Added:
[
1968
Added:
tag "label" [] [ txt "Confirm normal sets" ];
1969
Added:
void "input"
1970
Added:
([ type_ "text"; name "acknowledgement"; required ]
1971
Added:
@
1972
Added:
match acknowledgement with
1973
Added:
| Some ack -> [ Dream_html.string_attr "value" "%s" ack ]
1974
Added:
| None -> []);
1975
Added:
];
1976
Added:
void "input" [ type_ "submit"; value "Confirm normal sets" ];
1977
Added:
]
1978
Added:
in
1979
Added:
let promote_workout_form batch_id workout_id =
1980
Added:
tag "form"
1981
Added:
[
1982
Added:
action Routes.import_promote_workout batch_id workout_id;
1983
Added:
post_form;
1984
Added:
class_ "import-promote-workout-form";
1985
Added:
]
1986
Added:
[
1987
Added:
Dream_html.csrf_tag request;
1988
Added:
void "input" [ type_ "submit"; value "Promote workout" ];
1989
Added:
]
1990
Added:
in
1991
Added:
let blockers_block (w : View_model.Import_workout.t) =
1992
Added:
match w.View_model.Import_workout.blockers with
1993
Added:
| [] -> [ tag "p" [ class_ "import-ready" ] [ txt "Ready to promote." ] ]
1994
Added:
| blockers ->
1995
Added:
[
1996
Added:
tag "p" [] [ txt "Blocked:" ];
1997
Added:
tag "ul"
1998
Added:
[ class_ "import-blockers" ]
1999
Added:
(List.map (fun b -> tag "li" [] [ txt "%s" b ]) blockers);
2000
Added:
]
2001
Added:
in
2002
Added:
let workout_section (w : View_model.Import_workout.t) =
2003
Added:
let batch_id = vm.View_model.Import_review.batch_id in
2004
Added:
let workout_id = w.View_model.Import_workout.id in
2005
Added:
(* Every distinct source name, in first-appearance order. *)
2006
Added:
let source_names =
2007
Added:
List.fold_left
2008
Added:
(fun acc (s : View_model.Import_set.t) ->
2009
Added:
let n = s.View_model.Import_set.exercise_name in
2010
Added:
if List.mem n acc then acc else acc @ [ n ])
2011
Added:
[] w.View_model.Import_workout.sets
2012
Added:
in
2013
Added:
tag "section"
2014
Added:
[ class_ "import-workout" ]
2015
Added:
([
2016
Added:
tag "h2" [] [ txt "%s" w.View_model.Import_workout.title ];
2017
Added:
tag "ul"
2018
Added:
[ class_ "import-sets" ]
2019
Added:
(List.map set_row w.View_model.Import_workout.sets);
2020
Added:
]
2021
Added:
@ blockers_block w
2022
Added:
@ List.map (mapping_form batch_id workout_id) source_names
2023
Added:
@ [
2024
Added:
confirm_form batch_id workout_id
2025
Added:
w.View_model.Import_workout.acknowledgement;
2026
Added:
promote_workout_form batch_id workout_id;
2027
Added:
])
2028
Added:
in
2029
Added:
let batch_promote_form =
2030
Added:
tag "form"
2031
Added:
[
2032
Added:
action Routes.import_promote_batch vm.View_model.Import_review.batch_id;
2033
Added:
post_form;
2034
Added:
class_ "import-promote-batch-form";
2035
Added:
]
2036
Added:
[
2037
Added:
Dream_html.csrf_tag request;
2038
Added:
void "input" [ type_ "submit"; value "Promote whole batch" ];
2039
Added:
]
2040
Added:
in
2041
Added:
html_page ~viewer ~request ~active:"profile" "Import review"
2042
Added:
([ tag "h1" [] [ txt "Import review" ] ]
2043
Added:
@ warnings_block
2044
Added:
@ List.map workout_section vm.View_model.Import_review.workouts
2045
Added:
@ [ batch_promote_form ])
lib/web/pages.mli
@@ -80,6 +80,17 @@
80
80
an independent form. [username_error] and [password_error] report a refused
81
81
change inline. [notice] confirms a successful one. *)
82
82
83
Added:
val import_review :
84
Added:
Dream.request ->
85
Added:
viewer:View_model.Viewer.t ->
86
Added:
View_model.Import_review.t ->
87
Added:
page
88
Added:
(** The review of a provisional Hevy import batch. Lists the rows dropped on
89
Added:
parse, then each workout with its sets, blockers, and acknowledgement state.
90
Added:
Renders a mapping form per distinct source name, a normal-set confirmation
91
Added:
form, a per-workout promote form, and a batch promote form. Basic accessible
92
Added:
HTML: it names no core entity, only the view model. *)
93
Added:
83
94
val problem : title:string -> detail:string -> page
84
95
85
96
val error_page : status:int -> page
lib/web/routes.ml
@@ -17,6 +17,12 @@
17
17
let%path profile = "/profile"
18
18
let%path profile_username = "/profile/username"
19
19
let%path profile_password = "/profile/password"
20
Added:
let%path import_upload = "/profile/import"
21
Added:
let%path import_review = "/profile/import/%s"
22
Added:
let%path import_map = "/profile/import/%s/workouts/%s/map"
23
Added:
let%path import_confirm = "/profile/import/%s/workouts/%s/confirm"
24
Added:
let%path import_promote_workout = "/profile/import/%s/workouts/%s/promote"
25
Added:
let%path import_promote_batch = "/profile/import/%s/promote"
20
26
let%path app_feedback = "/app-feedback"
21
27
let%path submit_app_feedback = "/app-feedback/submit"
22
28
let%path upvote_app_feedback = "/app-feedback/%s/upvote"
lib/web/view_model.ml
@@ -131,3 +131,53 @@
131
131
stimuli it holds, and whether it is complete. No Repository record and no
132
132
Evidence.Workout entity. *)
133
133
end
134
Added:
135
Added:
module Import_warning = struct
136
Added:
type t = {
137
Added:
row : int; (** The source row that the adapter dropped. *)
138
Added:
detail : string; (** Why the row was dropped, already phrased. *)
139
Added:
}
140
Added:
(** One dropped import row, ready to render. The controller phrases the
141
Added:
reason, so no adapter warning variant crosses the boundary. *)
142
Added:
end
143
Added:
144
Added:
module Import_set = struct
145
Added:
type t = {
146
Added:
row : int; (** The source row, for provenance. *)
147
Added:
exercise_name : string; (** The export's exercise name, before mapping. *)
148
Added:
set_type : string; (** The set type, already phrased. *)
149
Added:
weight : string; (** The load, already formatted. *)
150
Added:
reps : string; (** The rep count, already formatted. *)
151
Added:
mapping : string option;
152
Added:
(** The catalog exercise name this set maps to, when confirmed. *)
153
Added:
}
154
Added:
(** One provisional import set, ready to render. Carries only strings, no
155
Added:
source-set entity. *)
156
Added:
end
157
Added:
158
Added:
module Import_workout = struct
159
Added:
type t = {
160
Added:
id : string; (** The workout id, for the per-workout forms. *)
161
Added:
title : string;
162
Added:
sets : Import_set.t list;
163
Added:
blockers : string list;
164
Added:
(** Why the workout cannot promote yet, each already phrased. Empty when
165
Added:
the workout can promote. *)
166
Added:
acknowledgement : string option;
167
Added:
(** The retained normal-set acknowledgement, when present. *)
168
Added:
revision : int; (** The workout revision, for provenance display. *)
169
Added:
}
170
Added:
(** One provisional import workout, ready to render: its sets, its blockers,
171
Added:
and its acknowledgement state. No Workout_import entity. *)
172
Added:
end
173
Added:
174
Added:
module Import_review = struct
175
Added:
type t = {
176
Added:
batch_id : string;
177
Added:
warnings : Import_warning.t list;
178
Added:
workouts : Import_workout.t list;
179
Added:
}
180
Added:
(** A provisional import batch under review: the rows dropped on parse and the
181
Added:
workouts awaiting cleaning and promotion. No batch entity crosses the
182
Added:
boundary. *)
183
Added:
end
test/test_web.ml
@@ -90,7 +90,44 @@
90
90
remember client response;
91
91
response
92
92
93
Removed:
(* A tiny substring search, since Str is not a dependency here. *)
93
Added:
(* A multipart/form-data POST. [file] is [(field, filename, content)]; [fields]
94
Added:
are plain text parts. The CSRF token rides as its own text part, exactly as
95
Added:
[Dream.csrf_tag] renders it into a browser form, so [Dream.multipart ~csrf]
96
Added:
verifies it. The boundary is fixed but improbable in the body. *)
97
Added:
let post_multipart client target ~file ~fields =
98
Added:
let boundary = "----hitotestboundary7Xk2p" in
99
Added:
let buf = Buffer.create 1024 in
100
Added:
let part_field (name, value) =
101
Added:
Buffer.add_string buf ("--" ^ boundary ^ "\r\n");
102
Added:
Buffer.add_string buf
103
Added:
(Printf.sprintf "Content-Disposition: form-data; name=%S\r\n\r\n" name);
104
Added:
Buffer.add_string buf value;
105
Added:
Buffer.add_string buf "\r\n"
106
Added:
in
107
Added:
List.iter part_field fields;
108
Added:
(match file with
109
Added:
| Some (name, filename, content) ->
110
Added:
Buffer.add_string buf ("--" ^ boundary ^ "\r\n");
111
Added:
Buffer.add_string buf
112
Added:
(Printf.sprintf
113
Added:
"Content-Disposition: form-data; name=%S; filename=%S\r\n" name
114
Added:
filename);
115
Added:
Buffer.add_string buf "Content-Type: text/csv\r\n\r\n";
116
Added:
Buffer.add_string buf content;
117
Added:
Buffer.add_string buf "\r\n"
118
Added:
| None -> ());
119
Added:
Buffer.add_string buf ("--" ^ boundary ^ "--\r\n");
120
Added:
let response =
121
Added:
Dream.test client.app
122
Added:
(Dream.request ~method_:`POST ~target
123
Added:
~headers:
124
Added:
(("Content-Type", "multipart/form-data; boundary=" ^ boundary)
125
Added:
:: cookie_header client)
126
Added:
(Buffer.contents buf))
127
Added:
in
128
Added:
remember client response;
129
Added:
response
130
Added:
94
131
let index_from ~needle haystack start =
95
132
let n = String.length needle and h = String.length haystack in
96
133
let rec at i =
@@ -1779,6 +1816,383 @@
1779
1816
Alcotest.(check int)
1780
1817
"Bob cannot open a record he does not own" 404
1781
1818
(status (get bob "/logbook/w1")) );
1819
Added:
] );
1820
Added:
( "web.import",
1821
Added:
(* The Hevy import web flow, end to end. Each test drives the multipart
1822
Added:
upload and the review POSTs, then asserts status, redirect location,
1823
Added:
and Repository state — never rendered HTML. The CSRF token is read from
1824
Added:
the profile page body, as a browser would. *)
1825
Added:
let header =
1826
Added:
"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"
1827
Added:
in
1828
Added:
(* One native row. Datetimes are Hevy local wall time. *)
1829
Added:
let row ~title ~exercise ~set_type ~weight ~reps ?(set_index = 0)
1830
Added:
?(start = "01 Jan 2024, 10:00") ?(finish = "01 Jan 2024, 11:00") () =
1831
Added:
Printf.sprintf "%s,%S,%S,,%s,,,%d,%s,%s,%d,,,\r\n" title start finish
1832
Added:
exercise set_index set_type weight reps
1833
Added:
in
1834
Added:
let csv rows = header ^ String.concat "" rows in
1835
Added:
(* Register, then read a CSRF token from the profile page. *)
1836
Added:
let signed_in_profile_token c =
1837
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1838
Added:
Option.get (csrf_token (body (get c "/profile")))
1839
Added:
in
1840
Added:
let review_token c url = Option.get (csrf_token (body (get c url))) in
1841
Added:
let batches repo trainee =
1842
Added:
Lwt_main.run (Memory_repo.import_batches repo trainee.Trainee.id)
1843
Added:
in
1844
Added:
let imported repo trainee =
1845
Added:
Lwt_main.run (Memory_repo.imported_records repo trainee.Trainee.id)
1846
Added:
in
1847
Added:
[
1848
Added:
( "a valid native export uploads to a stored batch with immutable source",
1849
Added:
`Quick,
1850
Added:
fun () ->
1851
Added:
let c, repo = client_with_repo () in
1852
Added:
let token = signed_in_profile_token c in
1853
Added:
let trainee = the_trainee repo ~username:"lifter" in
1854
Added:
let source =
1855
Added:
csv
1856
Added:
[
1857
Added:
row ~title:"Legs" ~exercise:"Barbell Squat"
1858
Added:
~set_type:"failure" ~weight:"100" ~reps:8 ();
1859
Added:
]
1860
Added:
in
1861
Added:
let response =
1862
Added:
post_multipart c "/profile/import"
1863
Added:
~file:(Some ("csv", "workouts.csv", source))
1864
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
1865
Added:
in
1866
Added:
Alcotest.(check int) "303 to review" 303 (status response);
1867
Added:
Alcotest.(check bool)
1868
Added:
"redirects to the review URL" true
1869
Added:
(index_from ~needle:"/profile/import/" (location response) 0
1870
Added:
|> Option.is_some);
1871
Added:
let stored = batches repo trainee in
1872
Added:
Alcotest.(check int) "one batch stored" 1 (List.length stored);
1873
Added:
Alcotest.(check string)
1874
Added:
"source retained verbatim" source
1875
Added:
(Workout_import.batch_source (List.hd stored)) );
1876
Added:
( "a duplicate upload is refused, the override stores a second batch",
1877
Added:
`Quick,
1878
Added:
fun () ->
1879
Added:
let c, repo = client_with_repo () in
1880
Added:
let token = signed_in_profile_token c in
1881
Added:
let trainee = the_trainee repo ~username:"lifter" in
1882
Added:
let source =
1883
Added:
csv
1884
Added:
[
1885
Added:
row ~title:"Legs" ~exercise:"Barbell Squat"
1886
Added:
~set_type:"failure" ~weight:"100" ~reps:8 ();
1887
Added:
]
1888
Added:
in
1889
Added:
let upload ?(allow = false) () =
1890
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1891
Added:
let fields =
1892
Added:
[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
1893
Added:
@ if allow then [ ("allow_duplicate", "true") ] else []
1894
Added:
in
1895
Added:
post_multipart c "/profile/import"
1896
Added:
~file:(Some ("csv", "workouts.csv", source))
1897
Added:
~fields
1898
Added:
in
1899
Added:
ignore token;
1900
Added:
let first = upload () in
1901
Added:
Alcotest.(check int) "first upload 303" 303 (status first);
1902
Added:
let second = upload () in
1903
Added:
Alcotest.(check int)
1904
Added:
"duplicate redirects to profile" 303 (status second);
1905
Added:
Alcotest.(check string)
1906
Added:
"duplicate lands on profile" "/profile" (location second);
1907
Added:
Alcotest.(check int)
1908
Added:
"still one batch after duplicate" 1
1909
Added:
(List.length (batches repo trainee));
1910
Added:
let overridden = upload ~allow:true () in
1911
Added:
Alcotest.(check int) "override 303" 303 (status overridden);
1912
Added:
let stored = batches repo trainee in
1913
Added:
Alcotest.(check int)
1914
Added:
"override stores a second batch" 2 (List.length stored);
1915
Added:
(* The two batches have distinct ids, so the override did not
1916
Added:
overwrite the original. *)
1917
Added:
let ids =
1918
Added:
List.map
1919
Added:
(fun b ->
1920
Added:
Workout_import.batch_id_to_string
1921
Added:
(Workout_import.batch_identity b))
1922
Added:
stored
1923
Added:
in
1924
Added:
Alcotest.(check bool)
1925
Added:
"the two batch ids differ" true
1926
Added:
(match ids with [ a; b ] -> a <> b | _ -> false) );
1927
Added:
( "warmup and unsupported rows persist as warnings, not sets",
1928
Added:
`Quick,
1929
Added:
fun () ->
1930
Added:
let c, repo = client_with_repo () in
1931
Added:
let token = signed_in_profile_token c in
1932
Added:
let trainee = the_trainee repo ~username:"lifter" in
1933
Added:
let source =
1934
Added:
csv
1935
Added:
[
1936
Added:
row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"warmup"
1937
Added:
~weight:"40" ~reps:10 ~set_index:0 ();
1938
Added:
row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"wibble"
1939
Added:
~weight:"50" ~reps:10 ~set_index:1 ();
1940
Added:
row ~title:"Legs" ~exercise:"Barbell Squat"
1941
Added:
~set_type:"failure" ~weight:"100" ~reps:8 ~set_index:2 ();
1942
Added:
]
1943
Added:
in
1944
Added:
let response =
1945
Added:
post_multipart c "/profile/import"
1946
Added:
~file:(Some ("csv", "workouts.csv", source))
1947
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
1948
Added:
in
1949
Added:
Alcotest.(check int) "303 to review" 303 (status response);
1950
Added:
let batch = List.hd (batches repo trainee) in
1951
Added:
(* Two warnings: the warmup and the unknown set type. *)
1952
Added:
Alcotest.(check int)
1953
Added:
"two rows dropped as warnings" 2
1954
Added:
(List.length (Workout_import.batch_warnings batch));
1955
Added:
(* The workout keeps only the one failure set; no provisional set
1956
Added:
was invented for the dropped rows. *)
1957
Added:
let w = List.hd (Workout_import.batch_workouts batch) in
1958
Added:
Alcotest.(check int)
1959
Added:
"only the failure set survives" 1
1960
Added:
(List.length (Workout_import.workout_sets w)) );
1961
Added:
( "map, confirm, then promote writes an imported record",
1962
Added:
`Quick,
1963
Added:
fun () ->
1964
Added:
let c, repo = client_with_repo () in
1965
Added:
let token = signed_in_profile_token c in
1966
Added:
let trainee = the_trainee repo ~username:"lifter" in
1967
Added:
(* A single normal set: it needs both a mapping and a normal-set
1968
Added:
confirmation before it can promote. *)
1969
Added:
let source =
1970
Added:
csv
1971
Added:
[
1972
Added:
row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"normal"
1973
Added:
~weight:"100" ~reps:8 ();
1974
Added:
]
1975
Added:
in
1976
Added:
let _ =
1977
Added:
post_multipart c "/profile/import"
1978
Added:
~file:(Some ("csv", "workouts.csv", source))
1979
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
1980
Added:
in
1981
Added:
let batch = List.hd (batches repo trainee) in
1982
Added:
let bid =
1983
Added:
Workout_import.batch_id_to_string
1984
Added:
(Workout_import.batch_identity batch)
1985
Added:
in
1986
Added:
let wid =
1987
Added:
Workout_import.workout_id_to_string
1988
Added:
(Workout_import.workout_identity
1989
Added:
(List.hd (Workout_import.batch_workouts batch)))
1990
Added:
in
1991
Added:
let review = "/profile/import/" ^ bid in
1992
Added:
let map_url =
1993
Added:
Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid
1994
Added:
in
1995
Added:
let t = review_token c review in
1996
Added:
let _ =
1997
Added:
post c map_url
1998
Added:
[
1999
Added:
("dream.csrf", t);
2000
Added:
("source_name", "Barbell Squat");
2001
Added:
("exercise_id", "squats");
2002
Added:
]
2003
Added:
in
2004
Added:
let t = review_token c review in
2005
Added:
let confirm_url =
2006
Added:
Printf.sprintf "/profile/import/%s/workouts/%s/confirm" bid wid
2007
Added:
in
2008
Added:
let _ =
2009
Added:
post c confirm_url
2010
Added:
[ ("dream.csrf", t); ("acknowledgement", "clean form") ]
2011
Added:
in
2012
Added:
let t = review_token c review in
2013
Added:
let promote_url =
2014
Added:
Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid
2015
Added:
in
2016
Added:
let promote = post c promote_url [ ("dream.csrf", t) ] in
2017
Added:
Alcotest.(check int) "promotion redirects" 303 (status promote);
2018
Added:
Alcotest.(check int)
2019
Added:
"one imported record exists" 1
2020
Added:
(List.length (imported repo trainee)) );
2021
Added:
( "a dropset workout stays blocked and writes no record",
2022
Added:
`Quick,
2023
Added:
fun () ->
2024
Added:
let c, repo = client_with_repo () in
2025
Added:
let token = signed_in_profile_token c in
2026
Added:
let trainee = the_trainee repo ~username:"lifter" in
2027
Added:
let source =
2028
Added:
csv
2029
Added:
[
2030
Added:
row ~title:"Legs" ~exercise:"Barbell Squat"
2031
Added:
~set_type:"dropset" ~weight:"100" ~reps:8 ();
2032
Added:
]
2033
Added:
in
2034
Added:
let _ =
2035
Added:
post_multipart c "/profile/import"
2036
Added:
~file:(Some ("csv", "workouts.csv", source))
2037
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
2038
Added:
in
2039
Added:
let batch = List.hd (batches repo trainee) in
2040
Added:
let bid =
2041
Added:
Workout_import.batch_id_to_string
2042
Added:
(Workout_import.batch_identity batch)
2043
Added:
in
2044
Added:
let wid =
2045
Added:
Workout_import.workout_id_to_string
2046
Added:
(Workout_import.workout_identity
2047
Added:
(List.hd (Workout_import.batch_workouts batch)))
2048
Added:
in
2049
Added:
let review = "/profile/import/" ^ bid in
2050
Added:
(* Map the dropset's exercise so only the dropset itself blocks. *)
2051
Added:
let t = review_token c review in
2052
Added:
let _ =
2053
Added:
post c
2054
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid)
2055
Added:
[
2056
Added:
("dream.csrf", t);
2057
Added:
("source_name", "Barbell Squat");
2058
Added:
("exercise_id", "squats");
2059
Added:
]
2060
Added:
in
2061
Added:
let t = review_token c review in
2062
Added:
let promote =
2063
Added:
post c
2064
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid)
2065
Added:
[ ("dream.csrf", t) ]
2066
Added:
in
2067
Added:
Alcotest.(check int) "still a redirect" 303 (status promote);
2068
Added:
Alcotest.(check int)
2069
Added:
"no record written for a dropset" 0
2070
Added:
(List.length (imported repo trainee)) );
2071
Added:
( "a partial batch promotion promotes the eligible sibling and retains \
2072
Added:
the blocked one",
2073
Added:
`Quick,
2074
Added:
fun () ->
2075
Added:
let c, repo = client_with_repo () in
2076
Added:
let token = signed_in_profile_token c in
2077
Added:
let trainee = the_trainee repo ~username:"lifter" in
2078
Added:
(* Two workouts: one ready failure set, one dropset that blocks. *)
2079
Added:
let source =
2080
Added:
csv
2081
Added:
[
2082
Added:
row ~title:"Legs" ~exercise:"Barbell Squat"
2083
Added:
~set_type:"failure" ~weight:"100" ~reps:8
2084
Added:
~start:"01 Jan 2024, 10:00" ~finish:"01 Jan 2024, 11:00" ();
2085
Added:
row ~title:"Arms" ~exercise:"Barbell Curl" ~set_type:"dropset"
2086
Added:
~weight:"30" ~reps:8 ~start:"02 Jan 2024, 10:00"
2087
Added:
~finish:"02 Jan 2024, 11:00" ();
2088
Added:
]
2089
Added:
in
2090
Added:
let _ =
2091
Added:
post_multipart c "/profile/import"
2092
Added:
~file:(Some ("csv", "workouts.csv", source))
2093
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
2094
Added:
in
2095
Added:
let batch = List.hd (batches repo trainee) in
2096
Added:
let bid =
2097
Added:
Workout_import.batch_id_to_string
2098
Added:
(Workout_import.batch_identity batch)
2099
Added:
in
2100
Added:
let review = "/profile/import/" ^ bid in
2101
Added:
(* Map the ready workout's exercise so its only blocker clears. *)
2102
Added:
let ready_wid =
2103
Added:
List.find_map
2104
Added:
(fun w ->
2105
Added:
if String.equal (Workout_import.workout_title w) "Legs" then
2106
Added:
Some
2107
Added:
(Workout_import.workout_id_to_string
2108
Added:
(Workout_import.workout_identity w))
2109
Added:
else None)
2110
Added:
(Workout_import.batch_workouts batch)
2111
Added:
|> Option.get
2112
Added:
in
2113
Added:
let t = review_token c review in
2114
Added:
let _ =
2115
Added:
post c
2116
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/map" bid
2117
Added:
ready_wid)
2118
Added:
[
2119
Added:
("dream.csrf", t);
2120
Added:
("source_name", "Barbell Squat");
2121
Added:
("exercise_id", "squats");
2122
Added:
]
2123
Added:
in
2124
Added:
let t = review_token c review in
2125
Added:
let promote =
2126
Added:
post c
2127
Added:
(Printf.sprintf "/profile/import/%s/promote" bid)
2128
Added:
[ ("dream.csrf", t) ]
2129
Added:
in
2130
Added:
Alcotest.(check int)
2131
Added:
"batch promotion redirects" 303 (status promote);
2132
Added:
(* Only the eligible sibling is promoted. The blocked dropset
2133
Added:
writes no record and stays in the batch. *)
2134
Added:
Alcotest.(check int)
2135
Added:
"one record from the eligible sibling" 1
2136
Added:
(List.length (imported repo trainee)) );
2137
Added:
( "an unknown batch GET is 404, an unknown exercise mapping changes \
2138
Added:
nothing",
2139
Added:
`Quick,
2140
Added:
fun () ->
2141
Added:
let c, repo = client_with_repo () in
2142
Added:
let token = signed_in_profile_token c in
2143
Added:
let trainee = the_trainee repo ~username:"lifter" in
2144
Added:
(* Unknown batch id: the review GET is a 404. *)
2145
Added:
ignore token;
2146
Added:
Alcotest.(check int)
2147
Added:
"unknown batch review is 404" 404
2148
Added:
(status (get c "/profile/import/no-such-batch"));
2149
Added:
(* Upload a real batch, then map to an id absent from the catalog.
2150
Added:
No mapping is recorded. *)
2151
Added:
let source =
2152
Added:
csv
2153
Added:
[
2154
Added:
row ~title:"Legs" ~exercise:"Barbell Squat" ~set_type:"normal"
2155
Added:
~weight:"100" ~reps:8 ();
2156
Added:
]
2157
Added:
in
2158
Added:
let up_token = Option.get (csrf_token (body (get c "/profile"))) in
2159
Added:
let _ =
2160
Added:
post_multipart c "/profile/import"
2161
Added:
~file:(Some ("csv", "workouts.csv", source))
2162
Added:
~fields:
2163
Added:
[ ("dream.csrf", up_token); ("utc_offset_seconds", "0") ]
2164
Added:
in
2165
Added:
let batch = List.hd (batches repo trainee) in
2166
Added:
let bid =
2167
Added:
Workout_import.batch_id_to_string
2168
Added:
(Workout_import.batch_identity batch)
2169
Added:
in
2170
Added:
let wid =
2171
Added:
Workout_import.workout_id_to_string
2172
Added:
(Workout_import.workout_identity
2173
Added:
(List.hd (Workout_import.batch_workouts batch)))
2174
Added:
in
2175
Added:
let review = "/profile/import/" ^ bid in
2176
Added:
let t = review_token c review in
2177
Added:
let response =
2178
Added:
post c
2179
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid)
2180
Added:
[
2181
Added:
("dream.csrf", t);
2182
Added:
("source_name", "Barbell Squat");
2183
Added:
("exercise_id", "not-an-exercise");
2184
Added:
]
2185
Added:
in
2186
Added:
Alcotest.(check int)
2187
Added:
"unknown exercise redirects, not errors" 303 (status response);
2188
Added:
(* The stored workout still has no mapping for the source name. *)
2189
Added:
let reloaded = List.hd (batches repo trainee) in
2190
Added:
let w = List.hd (Workout_import.batch_workouts reloaded) in
2191
Added:
Alcotest.(check bool)
2192
Added:
"no mapping was recorded" true
2193
Added:
(Option.is_none
2194
Added:
(Workout_import.workout_mapping w ~source_name:"Barbell Squat"))
2195
Added:
);
1782
2196
] );
1783
2197
]
1784
2198