[OCaml] High Intensity Training Online
feat rank feedback and allow cross-user votes
Changed files
lib/app/memory_repo.ml
@@ -4,17 +4,25 @@
4
4
mutable current : Evidence.Workout.t option;
5
5
mutable stored : Repository.record list; (* most recent first *)
6
6
mutable feedback : Evidence.Feedback.t list; (* most recent first *)
7
Removed:
mutable app_feedback : Repository.app_feedback list; (* most recent first *)
8
7
mutable next_id : int;
9
8
}
10
9
11
10
type t = {
12
11
mutable trainees : Trainee.t list;
13
12
states : (string, trainee_state) Hashtbl.t;
13
Added:
mutable app_feedback : (Trainee.id * Repository.app_feedback) list;
14
Added:
mutable app_feedback_votes : (Repository.app_feedback_id * Trainee.id) list;
14
15
mutable next_trainee : int;
15
16
}
16
17
17
Removed:
let create () = { trainees = []; states = Hashtbl.create 16; next_trainee = 1 }
18
Added:
let create () =
19
Added:
{
20
Added:
trainees = [];
21
Added:
states = Hashtbl.create 16;
22
Added:
app_feedback = [];
23
Added:
app_feedback_votes = [];
24
Added:
next_trainee = 1;
25
Added:
}
18
26
19
27
let state t id =
20
28
let key = Trainee.id_to_string id in
@@ -27,7 +35,6 @@
27
35
current = None;
28
36
stored = [];
29
37
feedback = [];
30
Removed:
app_feedback = [];
31
38
next_id = 1;
32
39
}
33
40
in
@@ -194,9 +201,126 @@
194
201
195
202
let feedback t id = Lwt.return (state t id).feedback
196
203
197
Removed:
let save_app_feedback t id report =
198
Removed:
let s = state t id in
199
Removed:
s.app_feedback <- report :: s.app_feedback;
200
Removed:
Lwt.return_unit
204
Added:
let save_app_feedback t id ~submitted_at ~message =
205
Added:
let author =
206
Added:
match
207
Added:
List.find_opt
208
Added:
(fun (trainee : Trainee.t) ->
209
Added:
String.equal
210
Added:
(Trainee.id_to_string trainee.id)
211
Added:
(Trainee.id_to_string id))
212
Added:
t.trainees
213
Added:
with
214
Added:
| Some trainee -> Trainee.username_to_string trainee.username
215
Added:
| None -> ""
216
Added:
in
217
Added:
let contributions =
218
Added:
1
219
Added:
+ List.fold_left
220
Added:
(fun count (owner, _) ->
221
Added:
if String.equal (Trainee.id_to_string owner) (Trainee.id_to_string id)
222
Added:
then count + 1
223
Added:
else count)
224
Added:
0 t.app_feedback
225
Added:
in
226
Added:
let feedback_id =
227
Added:
Repository.app_feedback_id
228
Added:
(Printf.sprintf "%s:%d" (Trainee.id_to_string id) contributions)
229
Added:
in
230
Added:
let report =
231
Added:
Repository.
232
Added:
{
233
Added:
feedback_id;
234
Added:
author;
235
Added:
contributions;
236
Added:
submitted_at;
237
Added:
message;
238
Added:
upvotes = 0;
239
Added:
viewer_upvoted = false;
240
Added:
}
241
Added:
in
242
Added:
t.app_feedback <- (id, report) :: t.app_feedback;
243
Added:
Lwt.return report
201
244
202
Removed:
let app_feedback t id = Lwt.return (state t id).app_feedback
245
Added:
let app_feedback t ~viewer =
246
Added:
let reports =
247
Added:
List.map
248
Added:
(fun (owner, report) ->
249
Added:
let owner_id = Trainee.id_to_string owner in
250
Added:
let contributions =
251
Added:
List.fold_left
252
Added:
(fun count (candidate, _) ->
253
Added:
if String.equal owner_id (Trainee.id_to_string candidate) then
254
Added:
count + 1
255
Added:
else count)
256
Added:
0 t.app_feedback
257
Added:
in
258
Added:
let viewer_upvoted =
259
Added:
List.exists
260
Added:
(fun (feedback_id, voter) ->
261
Added:
String.equal
262
Added:
(Repository.app_feedback_id_to_string feedback_id)
263
Added:
(Repository.app_feedback_id_to_string
264
Added:
report.Repository.feedback_id)
265
Added:
&& String.equal
266
Added:
(Trainee.id_to_string voter)
267
Added:
(Trainee.id_to_string viewer))
268
Added:
t.app_feedback_votes
269
Added:
in
270
Added:
{ report with contributions; viewer_upvoted })
271
Added:
t.app_feedback
272
Added:
in
273
Added:
let compare left right =
274
Added:
let by_votes =
275
Added:
Int.compare right.Repository.upvotes left.Repository.upvotes
276
Added:
in
277
Added:
if by_votes <> 0 then by_votes
278
Added:
else
279
Added:
Int.compare
280
Added:
(Recovery.timestamp_to_unix_seconds right.submitted_at)
281
Added:
(Recovery.timestamp_to_unix_seconds left.submitted_at)
282
Added:
in
283
Added:
Lwt.return (List.sort compare reports)
284
Added:
285
Added:
let upvote_app_feedback t ~voter feedback_id =
286
Added:
match
287
Added:
List.find_opt
288
Added:
(fun (_, report) ->
289
Added:
String.equal
290
Added:
(Repository.app_feedback_id_to_string report.Repository.feedback_id)
291
Added:
(Repository.app_feedback_id_to_string feedback_id))
292
Added:
t.app_feedback
293
Added:
with
294
Added:
| None -> Lwt.return false
295
Added:
| Some (owner, _)
296
Added:
when String.equal (Trainee.id_to_string owner) (Trainee.id_to_string voter)
297
Added:
->
298
Added:
Lwt.return false
299
Added:
| Some (_, report) ->
300
Added:
if
301
Added:
List.exists
302
Added:
(fun (voted_feedback, existing_voter) ->
303
Added:
String.equal
304
Added:
(Repository.app_feedback_id_to_string voted_feedback)
305
Added:
(Repository.app_feedback_id_to_string feedback_id)
306
Added:
&& String.equal
307
Added:
(Trainee.id_to_string existing_voter)
308
Added:
(Trainee.id_to_string voter))
309
Added:
t.app_feedback_votes
310
Added:
then Lwt.return false
311
Added:
else begin
312
Added:
t.app_feedback_votes <- (feedback_id, voter) :: t.app_feedback_votes;
313
Added:
t.app_feedback <-
314
Added:
List.map
315
Added:
(fun (owner, current) ->
316
Added:
if
317
Added:
String.equal
318
Added:
(Repository.app_feedback_id_to_string
319
Added:
current.Repository.feedback_id)
320
Added:
(Repository.app_feedback_id_to_string
321
Added:
report.Repository.feedback_id)
322
Added:
then (owner, { current with upvotes = current.upvotes + 1 })
323
Added:
else (owner, current))
324
Added:
t.app_feedback;
325
Added:
Lwt.return true
326
Added:
end
lib/app/migrations.ml
@@ -68,6 +68,21 @@
68
68
ON app_feedback (trainee_id, seq DESC)|};
69
69
];
70
70
};
71
Added:
{
72
Added:
version = 4;
73
Added:
name = "application feedback votes";
74
Added:
statements =
75
Added:
[
76
Added:
{|CREATE TABLE IF NOT EXISTS app_feedback_vote (
77
Added:
feedback_trainee_id TEXT NOT NULL,
78
Added:
feedback_seq INTEGER NOT NULL,
79
Added:
voter_id TEXT NOT NULL,
80
Added:
PRIMARY KEY (feedback_trainee_id, feedback_seq, voter_id)
81
Added:
)|};
82
Added:
{|CREATE INDEX IF NOT EXISTS app_feedback_vote_by_voter
83
Added:
ON app_feedback_vote (voter_id)|};
84
Added:
];
85
Added:
};
71
86
]
72
87
73
88
(* The ledger of applied migrations. A row per version, so a reconnect knows
lib/app/repository.ml
@@ -8,9 +8,21 @@
8
8
type record = { id : workout_id; workout : Evidence.Workout.t }
9
9
[@@warning "-69"]
10
10
11
Removed:
type app_feedback = { submitted_at : Recovery.timestamp; message : string }
12
Removed:
[@@warning "-69"]
11
Added:
type app_feedback_id = string
13
12
13
Added:
let app_feedback_id s = s
14
Added:
let app_feedback_id_to_string id = id
15
Added:
16
Added:
type app_feedback = {
17
Added:
feedback_id : app_feedback_id;
18
Added:
author : string;
19
Added:
contributions : int;
20
Added:
submitted_at : Recovery.timestamp;
21
Added:
message : string;
22
Added:
upvotes : int;
23
Added:
viewer_upvoted : bool;
24
Added:
}
25
Added:
14
26
module type S = sig
15
27
type t
16
28
@@ -49,6 +61,16 @@
49
61
val history : t -> Trainee.id -> record list Lwt.t
50
62
val save_feedback : t -> Trainee.id -> Evidence.Feedback.t -> unit Lwt.t
51
63
val feedback : t -> Trainee.id -> Evidence.Feedback.t list Lwt.t
52
Removed:
val save_app_feedback : t -> Trainee.id -> app_feedback -> unit Lwt.t
53
Removed:
val app_feedback : t -> Trainee.id -> app_feedback list Lwt.t
64
Added:
65
Added:
val save_app_feedback :
66
Added:
t ->
67
Added:
Trainee.id ->
68
Added:
submitted_at:Recovery.timestamp ->
69
Added:
message:string ->
70
Added:
app_feedback Lwt.t
71
Added:
72
Added:
val app_feedback : t -> viewer:Trainee.id -> app_feedback list Lwt.t
73
Added:
74
Added:
val upvote_app_feedback :
75
Added:
t -> voter:Trainee.id -> app_feedback_id -> bool Lwt.t
54
76
end
lib/app/repository.mli
@@ -19,9 +19,22 @@
19
19
(** A stored workout. It already knows its prescription, its timestamps, and the
20
20
basis on which it was begun. *)
21
21
22
Removed:
type app_feedback = { submitted_at : Recovery.timestamp; message : string }
23
Removed:
(** A freeform application comment submitted by one trainee. *)
22
Added:
type app_feedback_id = private string
24
23
24
Added:
val app_feedback_id : string -> app_feedback_id
25
Added:
val app_feedback_id_to_string : app_feedback_id -> string
26
Added:
27
Added:
type app_feedback = {
28
Added:
feedback_id : app_feedback_id;
29
Added:
author : string;
30
Added:
contributions : int;
31
Added:
submitted_at : Recovery.timestamp;
32
Added:
message : string;
33
Added:
upvotes : int;
34
Added:
viewer_upvoted : bool;
35
Added:
}
36
Added:
(** A ranked application comment with its author and viewer vote state. *)
37
Added:
25
38
(** Effects run in Lwt: an adapter may talk to a database. *)
26
39
module type S = sig
27
40
type t
@@ -97,9 +110,18 @@
97
110
val feedback : t -> Trainee.id -> Evidence.Feedback.t list Lwt.t
98
111
(** Stored feedback reports, most recent first. *)
99
112
100
Removed:
val save_app_feedback : t -> Trainee.id -> app_feedback -> unit Lwt.t
101
Removed:
(** Store a freeform application feedback report. *)
113
Added:
val save_app_feedback :
114
Added:
t ->
115
Added:
Trainee.id ->
116
Added:
submitted_at:Recovery.timestamp ->
117
Added:
message:string ->
118
Added:
app_feedback Lwt.t
119
Added:
(** Store a freeform application feedback report and return its identity. *)
102
120
103
Removed:
val app_feedback : t -> Trainee.id -> app_feedback list Lwt.t
104
Removed:
(** Stored application feedback, most recent first. *)
121
Added:
val app_feedback : t -> viewer:Trainee.id -> app_feedback list Lwt.t
122
Added:
(** Return all reports, ranked by upvotes, with the viewer's vote state. *)
123
Added:
124
Added:
val upvote_app_feedback :
125
Added:
t -> voter:Trainee.id -> app_feedback_id -> bool Lwt.t
126
Added:
(** Add one vote from another trainee. [false] means no vote was added. *)
105
127
end
lib/app/service.ml
@@ -266,10 +266,11 @@
266
266
let record t trainee ~submitted_at ~message =
267
267
if String.trim message = "" then Lwt.return (Error `Empty_message)
268
268
else
269
Removed:
let report = Repository.{ submitted_at; message } in
270
Removed:
R.save_app_feedback t.repo trainee report >|= fun () -> Ok report
269
Added:
R.save_app_feedback t.repo trainee ~submitted_at ~message
270
Added:
>|= fun report -> Ok report
271
271
272
Removed:
let list t trainee = R.app_feedback t.repo trainee
272
Added:
let list t trainee = R.app_feedback t.repo ~viewer:trainee
273
Added:
let upvote t trainee id = R.upvote_app_feedback t.repo ~voter:trainee id
273
274
end
274
275
275
276
(* Re-export the use cases as one flat service, matching Service.mli. *)
@@ -300,4 +301,5 @@
300
301
let feedback = Feedback.list
301
302
let record_app_feedback = App_feedback.record
302
303
let app_feedback = App_feedback.list
304
Added:
let upvote_app_feedback = App_feedback.upvote
303
305
end
lib/app/service.mli
@@ -208,5 +208,9 @@
208
208
(** Store a non-blank freeform application feedback message. *)
209
209
210
210
val app_feedback : t -> Trainee.id -> Repository.app_feedback list Lwt.t
211
Removed:
(** Stored application feedback, most recent first. *)
211
Added:
(** All application feedback, ranked by upvotes for this viewer. *)
212
Added:
213
Added:
val upvote_app_feedback :
214
Added:
t -> Trainee.id -> Repository.app_feedback_id -> bool Lwt.t
215
Added:
(** Try to add the trainee's vote to another trainee's feedback. *)
212
216
end
lib/app/sqlite_repo.ml
@@ -93,9 +93,32 @@
93
93
VALUES (?, ?, ?, ?)"
94
94
95
95
let app_feedback =
96
Removed:
(string ->* t3 int int string)
97
Removed:
"SELECT seq, submitted_at, message FROM app_feedback WHERE trainee_id = \
98
Removed:
? ORDER BY seq DESC"
96
Added:
(unit ->* t7 string int string int string int int)
97
Added:
"SELECT f.trainee_id, f.seq, t.username, f.submitted_at, f.message, \
98
Added:
(SELECT COUNT(*) FROM app_feedback c WHERE c.trainee_id = \
99
Added:
f.trainee_id), (SELECT COUNT(*) FROM app_feedback_vote v WHERE \
100
Added:
v.feedback_trainee_id = f.trainee_id AND v.feedback_seq = f.seq) FROM \
101
Added:
app_feedback f JOIN trainee t ON t.id = f.trainee_id ORDER BY 7 DESC, \
102
Added:
f.submitted_at DESC, f.trainee_id, f.seq DESC"
103
Added:
104
Added:
let viewer_votes =
105
Added:
(string ->* t2 string int)
106
Added:
"SELECT feedback_trainee_id, feedback_seq FROM app_feedback_vote WHERE \
107
Added:
voter_id = ?"
108
Added:
109
Added:
let feedback_owner =
110
Added:
(t2 string int ->? string)
111
Added:
"SELECT trainee_id FROM app_feedback WHERE trainee_id = ? AND seq = ?"
112
Added:
113
Added:
let vote_exists =
114
Added:
(t3 string int string ->? int)
115
Added:
"SELECT 1 FROM app_feedback_vote WHERE feedback_trainee_id = ? AND \
116
Added:
feedback_seq = ? AND voter_id = ?"
117
Added:
118
Added:
let insert_vote =
119
Added:
(t3 string int string ->. unit)
120
Added:
"INSERT INTO app_feedback_vote (feedback_trainee_id, feedback_seq, \
121
Added:
voter_id) VALUES (?, ?, ?)"
99
122
end
100
123
101
124
(* --- pool helper --- *)
@@ -325,24 +348,83 @@
325
348
Db.collect_list Q.feedback (Trainee.id_to_string id))
326
349
>|= List.map decode_feedback
327
350
328
Removed:
let save_app_feedback t id (report : Repository.app_feedback) =
351
Added:
let save_app_feedback t id ~submitted_at ~message =
329
352
let trainee = Trainee.id_to_string id in
330
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
331
Removed:
Db.find Q.next_app_feedback_seq trainee)
332
Removed:
>>= fun seq ->
333
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
334
Removed:
Db.exec Q.insert_app_feedback
335
Removed:
( trainee,
336
Removed:
seq,
337
Removed:
Recovery.timestamp_to_unix_seconds report.submitted_at,
338
Removed:
report.message ))
353
Added:
find_trainee t id >>= function
354
Added:
| None ->
355
Added:
Lwt.fail_with "cannot save application feedback for an unknown trainee"
356
Added:
| Some author ->
357
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
358
Added:
Db.find Q.next_app_feedback_seq trainee)
359
Added:
>>= fun seq ->
360
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
361
Added:
Db.exec Q.insert_app_feedback
362
Added:
( trainee,
363
Added:
seq,
364
Added:
Recovery.timestamp_to_unix_seconds submitted_at,
365
Added:
message ))
366
Added:
>|= fun () ->
367
Added:
Repository.
368
Added:
{
369
Added:
feedback_id = app_feedback_id (Printf.sprintf "%s:%d" trainee seq);
370
Added:
author = Trainee.username_to_string author.Trainee.username;
371
Added:
contributions = seq;
372
Added:
submitted_at;
373
Added:
message;
374
Added:
upvotes = 0;
375
Added:
viewer_upvoted = false;
376
Added:
}
339
377
340
Removed:
let app_feedback t id =
378
Added:
let app_feedback t ~viewer =
341
379
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
342
Removed:
Db.collect_list Q.app_feedback (Trainee.id_to_string id))
343
Removed:
>|= List.map (fun (_seq, submitted_at, message) ->
380
Added:
Db.collect_list Q.app_feedback ())
381
Added:
>>= fun rows ->
382
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
383
Added:
Db.collect_list Q.viewer_votes (Trainee.id_to_string viewer))
384
Added:
>|= fun voted ->
385
Added:
List.map
386
Added:
(fun (trainee, seq, author, submitted_at, message, contributions, upvotes)
387
Added:
->
344
388
Repository.
345
389
{
390
Added:
feedback_id = app_feedback_id (Printf.sprintf "%s:%d" trainee seq);
391
Added:
author;
392
Added:
contributions;
346
393
submitted_at = Recovery.timestamp_of_unix_seconds submitted_at;
347
394
message;
395
Added:
upvotes;
396
Added:
viewer_upvoted = List.mem (trainee, seq) voted;
348
397
})
398
Added:
rows
399
Added:
400
Added:
let split_app_feedback_id id =
401
Added:
let raw = Repository.app_feedback_id_to_string id in
402
Added:
match String.rindex_opt raw ':' with
403
Added:
| None -> None
404
Added:
| Some separator ->
405
Added:
let trainee = String.sub raw 0 separator in
406
Added:
let seq_start = separator + 1 in
407
Added:
let seq_length = String.length raw - seq_start in
408
Added:
Option.map
409
Added:
(fun seq -> (trainee, seq))
410
Added:
(int_of_string_opt (String.sub raw seq_start seq_length))
411
Added:
412
Added:
let upvote_app_feedback t ~voter id =
413
Added:
match split_app_feedback_id id with
414
Added:
| None -> Lwt.return false
415
Added:
| Some (trainee, seq) -> (
416
Added:
let voter = Trainee.id_to_string voter in
417
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
418
Added:
Db.find_opt Q.feedback_owner (trainee, seq))
419
Added:
>>= function
420
Added:
| None -> Lwt.return false
421
Added:
| Some owner when String.equal owner voter -> Lwt.return false
422
Added:
| Some _ -> (
423
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
424
Added:
Db.find_opt Q.vote_exists (trainee, seq, voter))
425
Added:
>>= function
426
Added:
| Some _ -> Lwt.return false
427
Added:
| None ->
428
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
429
Added:
Db.exec Q.insert_vote (trainee, seq, voter))
430
Added:
>|= fun () -> true))
lib/web/handlers.ml
@@ -547,12 +547,22 @@
547
547
| Error `Empty_message ->
548
548
render_error t trainee request Present.app_feedback_empty)
549
549
550
Added:
let upvote t trainee request id =
551
Added:
guard_csrf request >>= function
552
Added:
| Error _ -> bad_request Present.form_invalid
553
Added:
| Ok () ->
554
Added:
Service.upvote_app_feedback t.service trainee.Trainee.id
555
Added:
(Repository.app_feedback_id id)
556
Added:
>>= fun _ -> Dream.redirect request "/app-feedback?tab=submitted"
557
Added:
550
558
let routes t =
551
559
[
552
560
Dream_html.get Routes.app_feedback (fun request ->
553
561
authenticated t request (fun trainee -> show t trainee request));
554
562
Dream_html.post Routes.submit_app_feedback (fun request ->
555
563
authenticated t request (fun trainee -> submit t trainee request));
564
Added:
Dream_html.post Routes.upvote_app_feedback (fun request id ->
565
Added:
authenticated t request (fun trainee -> upvote t trainee request id));
556
566
]
557
567
end
558
568
lib/web/pages.ml
@@ -1316,6 +1316,36 @@
1316
1316
:: error_block
1317
1317
@ [ void "input" [ type_ "submit"; value "Submit feedback" ] ])
1318
1318
1319
Added:
let app_feedback_vote_form request ~trainee report =
1320
Added:
if
1321
Added:
String.equal report.Repository.author
1322
Added:
(Trainee.username_to_string trainee.Trainee.username)
1323
Added:
then tag "p" [ class_ "app-feedback-own" ] [ txt "Your feedback" ]
1324
Added:
else
1325
Added:
let label =
1326
Added:
if report.Repository.viewer_upvoted then "Upvoted"
1327
Added:
else Printf.sprintf "Upvote (%d)" report.Repository.upvotes
1328
Added:
in
1329
Added:
let attrs =
1330
Added:
[
1331
Added:
action Routes.upvote_app_feedback
1332
Added:
(Repository.app_feedback_id_to_string report.Repository.feedback_id);
1333
Added:
post_form;
1334
Added:
class_ "app-feedback-vote";
1335
Added:
]
1336
Added:
in
1337
Added:
let attrs =
1338
Added:
if report.Repository.viewer_upvoted then
1339
Added:
Dream_html.attr "disabled" :: attrs
1340
Added:
else attrs
1341
Added:
in
1342
Added:
tag "form" attrs
1343
Added:
[
1344
Added:
Dream_html.csrf_tag request;
1345
Added:
void "input"
1346
Added:
[ type_ "submit"; Dream_html.string_attr "value" "%s" label ];
1347
Added:
]
1348
Added:
1319
1349
let app_feedback request ?(logging = false) ~trainee ?(tab = `Write) ?error
1320
1350
reports =
1321
1351
let panel =
@@ -1340,6 +1370,12 @@
1340
1370
(fun (report : Repository.app_feedback) ->
1341
1371
tag "li" []
1342
1372
[
1373
Added:
tag "p"
1374
Added:
[ class_ "app-feedback-author" ]
1375
Added:
[
1376
Added:
txt "%s — %d contributions" report.author
1377
Added:
report.contributions;
1378
Added:
];
1343
1379
tag "time"
1344
1380
[
1345
1381
class_ "app-feedback-time";
@@ -1350,6 +1386,10 @@
1350
1386
tag "p"
1351
1387
[ class_ "app-feedback-message" ]
1352
1388
[ txt "%s" report.message ];
1389
Added:
tag "p"
1390
Added:
[ class_ "app-feedback-upvotes" ]
1391
Added:
[ txt "Upvotes: %d" report.upvotes ];
1392
Added:
app_feedback_vote_form request ~trainee report;
1353
1393
])
1354
1394
reports));
1355
1395
]
lib/web/routes.ml
@@ -19,6 +19,7 @@
19
19
let%path profile_password = "/profile/password"
20
20
let%path app_feedback = "/app-feedback"
21
21
let%path submit_app_feedback = "/app-feedback/submit"
22
Added:
let%path upvote_app_feedback = "/app-feedback/%s/upvote"
22
23
let%path feedback = "/feedback"
23
24
let%path record = "/logbook/%s"
24
25
let%path record_slot = "/logbook/%s/slots/%d"
test/test_service.ml
@@ -629,7 +629,7 @@
629
629
with
630
630
| Error `Empty_message -> ()
631
631
| Ok _ -> Alcotest.fail "expected a blank message to be refused" );
632
Removed:
( "app feedback is stored newest first and isolated by trainee",
632
Added:
( "app feedback is stored newest first and visible globally",
633
633
`Quick,
634
634
fun () ->
635
635
let s, alice = fixture () in
@@ -654,8 +654,68 @@
654
654
Alcotest.(check string)
655
655
"newest first" "Second" (List.hd alice_reports).Repository.message;
656
656
Alcotest.(check int)
657
Removed:
"bob has no reports" 0
657
Added:
"bob sees the same reports" 2
658
658
(List.length (run (S.app_feedback s bob))) );
659
Added:
( "application feedback is ranked and supports cross-user votes",
660
Added:
`Quick,
661
Added:
fun () ->
662
Added:
let s, alice = fixture () in
663
Added:
let bob =
664
Added:
(ok (run (S.register s ~username:"bobby" ~password:"heavyduty1")))
665
Added:
.Trainee.id
666
Added:
in
667
Added:
let _ =
668
Added:
ok
669
Added:
(run
670
Added:
(S.record_app_feedback s alice ~submitted_at:(day 1)
671
Added:
~message:"First"))
672
Added:
in
673
Added:
let _ =
674
Added:
ok
675
Added:
(run
676
Added:
(S.record_app_feedback s alice ~submitted_at:(day 2)
677
Added:
~message:"Second"))
678
Added:
in
679
Added:
let _ =
680
Added:
ok
681
Added:
(run
682
Added:
(S.record_app_feedback s bob ~submitted_at:(day 3)
683
Added:
~message:"From Bob"))
684
Added:
in
685
Added:
let before_vote = run (S.app_feedback s alice) in
686
Added:
let alice_report =
687
Added:
List.find
688
Added:
(fun report -> String.equal report.Repository.author "lifter")
689
Added:
before_vote
690
Added:
in
691
Added:
let bob_report =
692
Added:
List.find
693
Added:
(fun report -> String.equal report.Repository.author "bobby")
694
Added:
before_vote
695
Added:
in
696
Added:
Alcotest.(check int)
697
Added:
"alice contribution count" 2 alice_report.Repository.contributions;
698
Added:
Alcotest.(check int)
699
Added:
"bob contribution count" 1 bob_report.Repository.contributions;
700
Added:
Alcotest.(check bool)
701
Added:
"newest report starts first" true
702
Added:
(String.equal (List.hd before_vote).Repository.message "From Bob");
703
Added:
Alcotest.(check bool)
704
Added:
"cross-user vote is added" true
705
Added:
(run
706
Added:
(S.upvote_app_feedback s alice bob_report.Repository.feedback_id));
707
Added:
Alcotest.(check bool)
708
Added:
"own vote is refused" false
709
Added:
(run (S.upvote_app_feedback s bob bob_report.Repository.feedback_id));
710
Added:
let after_vote = run (S.app_feedback s alice) in
711
Added:
let voted_bob =
712
Added:
List.find
713
Added:
(fun report -> String.equal report.Repository.author "bobby")
714
Added:
after_vote
715
Added:
in
716
Added:
Alcotest.(check int) "upvote count" 1 voted_bob.Repository.upvotes;
717
Added:
Alcotest.(check bool)
718
Added:
"viewer vote state" true voted_bob.Repository.viewer_upvoted );
659
719
]
660
720
661
721
let suite =
test/test_sqlite_repo.ml
@@ -323,6 +323,80 @@
323
323
| reports ->
324
324
Alcotest.failf "expected one report, got %d"
325
325
(List.length reports)) );
326
Added:
( "application feedback ranking and votes survive a reconnect",
327
Added:
`Quick,
328
Added:
fun () ->
329
Added:
let path, uri = temp_uri () in
330
Added:
Fun.protect
331
Added:
~finally:(fun () -> cleanup path)
332
Added:
(fun () ->
333
Added:
let bob_feedback_id =
334
Added:
let repo = connect uri in
335
Added:
let s = S.make ~repo in
336
Added:
let alice =
337
Added:
(ok
338
Added:
(run (S.register s ~username:"alice" ~password:"heavyduty1")))
339
Added:
.Trainee.id
340
Added:
in
341
Added:
let bob =
342
Added:
(ok
343
Added:
(run (S.register s ~username:"bobby" ~password:"heavyduty1")))
344
Added:
.Trainee.id
345
Added:
in
346
Added:
let _ =
347
Added:
ok
348
Added:
(run
349
Added:
(S.record_app_feedback s alice ~submitted_at:(day 1)
350
Added:
~message:"From Alice"))
351
Added:
in
352
Added:
let bob_report =
353
Added:
ok
354
Added:
(run
355
Added:
(S.record_app_feedback s bob ~submitted_at:(day 2)
356
Added:
~message:"From Bob"))
357
Added:
in
358
Added:
Alcotest.(check bool)
359
Added:
"vote is accepted" true
360
Added:
(run
361
Added:
(S.upvote_app_feedback s alice
362
Added:
bob_report.Repository.feedback_id));
363
Added:
bob_report.Repository.feedback_id
364
Added:
in
365
Added:
let repo = connect uri in
366
Added:
let s = S.make ~repo in
367
Added:
let alice =
368
Added:
Option.get
369
Added:
(run
370
Added:
(S.authenticate s ~username:"alice" ~password:"heavyduty1"))
371
Added:
in
372
Added:
let bob =
373
Added:
Option.get
374
Added:
(run
375
Added:
(S.authenticate s ~username:"bobby" ~password:"heavyduty1"))
376
Added:
in
377
Added:
let reports = run (S.app_feedback s alice.Trainee.id) in
378
Added:
let bob_report =
379
Added:
List.find
380
Added:
(fun report -> String.equal report.Repository.author "bobby")
381
Added:
reports
382
Added:
in
383
Added:
Alcotest.(check string)
384
Added:
"feedback identity"
385
Added:
(Repository.app_feedback_id_to_string bob_feedback_id)
386
Added:
(Repository.app_feedback_id_to_string
387
Added:
bob_report.Repository.feedback_id);
388
Added:
Alcotest.(check int)
389
Added:
"vote persisted" 1 bob_report.Repository.upvotes;
390
Added:
Alcotest.(check bool)
391
Added:
"viewer vote persisted" true bob_report.Repository.viewer_upvoted;
392
Added:
let own_view =
393
Added:
List.find
394
Added:
(fun report -> String.equal report.Repository.author "bobby")
395
Added:
(run (S.app_feedback s bob.Trainee.id))
396
Added:
in
397
Added:
Alcotest.(check bool)
398
Added:
"owner does not see a self vote" false
399
Added:
own_view.Repository.viewer_upvoted) );
326
400
( "a username and password change survive a reconnect",
327
401
`Quick,
328
402
fun () ->
test/test_web.ml
@@ -1172,6 +1172,49 @@
1172
1172
Alcotest.(check bool)
1173
1173
"shows its timestamp" true
1174
1174
(contains ~substring:"app-feedback-time" list_page) );
1175
Added:
( "feedback lists authors and accepts another user's vote",
1176
Added:
`Quick,
1177
Added:
fun () ->
1178
Added:
let alice = client () in
1179
Added:
let _ = sign_in_new alice in
1180
Added:
let bob = { alice with jar = [] } in
1181
Added:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
1182
Added:
let submit client message =
1183
Added:
let page = body (get client "/app-feedback") in
1184
Added:
let token = Option.get (csrf_token page) in
1185
Added:
post client "/app-feedback/submit"
1186
Added:
[ ("dream.csrf", token); ("message", message) ]
1187
Added:
in
1188
Added:
Alcotest.(check int)
1189
Added:
"alice feedback accepted" 303
1190
Added:
(status (submit alice "Alice report"));
1191
Added:
Alcotest.(check int)
1192
Added:
"bob feedback accepted" 303
1193
Added:
(status (submit bob "Bob report"));
1194
Added:
let list_page = body (get alice "/app-feedback?tab=submitted") in
1195
Added:
Alcotest.(check bool)
1196
Added:
"shows the author" true
1197
Added:
(contains ~substring:"bobby — 1 contributions" list_page);
1198
Added:
Alcotest.(check bool)
1199
Added:
"shows the ranked vote control" true
1200
Added:
(contains ~substring:"action=\"/app-feedback/t2:1/upvote\""
1201
Added:
list_page);
1202
Added:
let token = Option.get (csrf_token list_page) in
1203
Added:
let voted =
1204
Added:
post alice "/app-feedback/t2:1/upvote" [ ("dream.csrf", token) ]
1205
Added:
in
1206
Added:
Alcotest.(check int) "upvote redirects" 303 (status voted);
1207
Added:
let ranked = body (get alice "/app-feedback?tab=submitted") in
1208
Added:
Alcotest.(check bool)
1209
Added:
"shows the vote count" true
1210
Added:
(contains ~substring:"Upvotes: 1" ranked);
1211
Added:
Alcotest.(check bool)
1212
Added:
"marks the viewer's vote" true
1213
Added:
(contains ~substring:"value=\"Upvoted\"" ranked);
1214
Added:
let bob_page = body (get bob "/app-feedback?tab=submitted") in
1215
Added:
Alcotest.(check bool)
1216
Added:
"identifies the owner's feedback" true
1217
Added:
(contains ~substring:"Your feedback" bob_page) );
1175
1218
] );
1176
1219
( "web.profile",
1177
1220
[