Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
feat: Offer better protections against solution overwriting (#372)
* Mechanism 1:
  We disable the automatic and implicit saving of the student answer when the browser tab is closed. Instead, we ask the user to confirm that she wants to leave the page (unless the answer has already been synchronized).
  Related: https://developer.mozilla.org/en-US/docs/Web/API/WindowEventHandlers/onbeforeunload#example

* Mechanism 2:
  When an answer has not been modified for 3 minutes, we check (upon next keystroke) if a more recent solution exists on the server. In that case, we ask the user if she/he wants to download the most recent version.

* Mechanism 3:
  To avoid overloading the server with many synchronization requests, we disable the synchronization button when the answer is synchronized, and reactive it only when a modification is made on the answer.

Close #316
Fix #467

Co-authored-by: Yann Regis-Gianas <yann@regis-gianas.org>
Co-authored-by: Erik Martin-Dorel <erik.martin-dorel@irit.fr>
  • Loading branch information
yurug and erikmd committed Mar 5, 2022
1 parent 82a314a commit 5c12539
Show file tree
Hide file tree
Showing 10 changed files with 272 additions and 108 deletions.
34 changes: 30 additions & 4 deletions src/ace-lib/ace.ml
@@ -1,6 +1,6 @@
(* This file is part of Learn-OCaml.
*
* Copyright (C) 2019 OCaml Software Foundation.
* Copyright (C) 2019-2022 OCaml Software Foundation.
* Copyright (C) 2016-2018 OCamlPro.
*
* Learn-OCaml is distributed under the terms of the MIT license. See the
Expand All @@ -20,6 +20,8 @@ type 'a editor = {
editor: ('a editor * 'a option) Ace_types.editor Js.t;
mutable marks: int list;
mutable keybinding_menu: bool;
mutable synchronized : bool;
mutable sync_observers : (bool -> unit) list;
}

let ace : Ace_types.ace Js.t = Js.Unsafe.variable "ace"
Expand All @@ -30,10 +32,13 @@ let create_position r c =
pos##.row := r;
pos##.column := c;
pos

let greater_position p1 p2 =
p1##.row > p2##.row ||
(p1##.row = p2##.row && p1##.column > p2##.column)

let register_sync_observer editor obs =
editor.sync_observers <- obs :: editor.sync_observers

let create_range s e =
let range : range Js.t = Js.Unsafe.obj [||] in
Expand Down Expand Up @@ -77,15 +82,37 @@ let get_contents ?range e =
let r = create_range (create_position r1 c1) (create_position r2 c2) in
Js.to_string @@ document##(getTextRange r)

let create_editor editor_div =
let set_synchronized_status editor status =
List.iter (fun obs -> obs status) editor.sync_observers;
editor.synchronized <- status

let focus { editor } = editor##focus

let create_editor editor_div check_valid_state =
let editor = edit editor_div in
Js.Unsafe.set editor "$blockScrolling" (Js.Unsafe.variable "Infinity");
let data =
{ editor; editor_div; marks = []; keybinding_menu = false; } in
{ editor; editor_div;
marks = [];
keybinding_menu = false;
synchronized = true;
sync_observers = []
}
in
editor##.customData := (data, None);
editor##setOption (Js.string "displayIndentGuides") (Js.bool false);
editor##on (Js.string "change") (fun () ->
check_valid_state (set_contents data) (fun () -> focus data)
(fun () -> set_synchronized_status data true);
set_synchronized_status data false);
data

let set_synchronized editor =
set_synchronized_status editor true

let is_synchronized editor =
editor.synchronized

let get_custom_data { editor } =
match snd editor##.customData with
| None -> raise Not_found
Expand Down Expand Up @@ -168,7 +195,6 @@ let clear_marks editor =
let record_event_handler editor event handler =
editor.editor##(on (Js.string event) handler)

let focus { editor } = editor##focus
let resize { editor } force = editor##(resize (Js.bool force))

let get_keybinding_menu e =
Expand Down
9 changes: 8 additions & 1 deletion src/ace-lib/ace.mli
Expand Up @@ -17,7 +17,14 @@ type loc = {
loc_end: int * int;
}

val create_editor: Dom_html.divElement Js.t -> 'a editor
val create_editor: Dom_html.divElement Js.t
-> ((string -> unit) -> (unit -> unit) -> (unit -> unit) -> unit) -> 'a editor

val is_synchronized : 'a editor -> bool

val set_synchronized : 'a editor -> unit

val register_sync_observer : 'a editor -> (bool -> unit) -> unit

val set_mode: 'a editor -> string -> unit

Expand Down
4 changes: 2 additions & 2 deletions src/ace-lib/ocaml_mode.ml
Expand Up @@ -514,8 +514,8 @@ let do_delete ace_editor =
Ace.remove ace_editor "left"
end

let create_ocaml_editor div =
let ace = Ace.create_editor div in
let create_ocaml_editor div check_valid_state =
let ace = Ace.create_editor div check_valid_state in
Ace.set_mode ace "ace/mode/ocaml.ocp";
Ace.set_tab_size ace !config.indent.IndentConfig.i_base;
let editor = { ace; current_error = None; current_warnings = [] } in
Expand Down
4 changes: 2 additions & 2 deletions src/ace-lib/ocaml_mode.mli
Expand Up @@ -20,12 +20,12 @@ type msg = {
msg: string;
}


type error = msg list

type warning = error

val create_ocaml_editor: Dom_html.divElement Js.t -> editor
val create_ocaml_editor:
Dom_html.divElement Js.t -> ((string -> unit) -> (unit -> unit) -> (unit -> unit) -> unit) -> editor
val get_editor: editor -> editor Ace.editor

val report_error: editor -> ?set_class: bool -> error option -> warning list -> unit Lwt.t
Expand Down
108 changes: 92 additions & 16 deletions src/app/learnocaml_common.ml
@@ -1,6 +1,6 @@
(* This file is part of Learn-OCaml.
*
* Copyright (C) 2019 OCaml Software Foundation.
* Copyright (C) 2019-2020 OCaml Software Foundation.
* Copyright (C) 2016-2018 OCamlPro.
*
* Learn-OCaml is distributed under the terms of the MIT license. See the
Expand Down Expand Up @@ -434,30 +434,34 @@ let get_state_as_save_file ?(include_reports = false) () =
all_exercise_toplevel_histories = retrieve all_exercise_toplevel_histories;
}

let rec sync_save token save_file =
let rec sync_save token save_file on_sync =
Server_caller.request (Learnocaml_api.Update_save (token, save_file))
>>= function
| Ok save -> set_state_from_save_file ~token save; Lwt.return save
| Ok save ->
set_state_from_save_file ~token save;
on_sync ();
Lwt.return save
| Error (`Not_found _) ->
Server_caller.request_exn
(Learnocaml_api.Create_token ("", Some token, None)) >>= fun _token ->
assert (_token = token);
Server_caller.request_exn
(Learnocaml_api.Update_save (token, save_file)) >>= fun save ->
set_state_from_save_file ~token save;
on_sync ();
Lwt.return save
| Error e ->
lwt_alert ~title:[%i"SYNC FAILED"] [
H.p [H.txt [%i"Could not synchronise save with the server"]];
H.code [H.txt (Server_caller.string_of_error e)];
] ~buttons:[
[%i"Retry"], (fun () -> sync_save token save_file);
[%i"Ignore"], (fun () -> Lwt.return save_file);
[%i"Retry"], (fun () -> sync_save token save_file on_sync);
[%i"Ignore"], (fun () -> Lwt.return save_file);
]

let sync token = sync_save token (get_state_as_save_file ())
let sync token on_sync = sync_save token (get_state_as_save_file ()) on_sync

let sync_exercise token ?answer ?editor id =
let sync_exercise token ?answer ?editor id on_sync =
let handle_serverless () =
(* save the text at least locally (but not the report & grade, that could
be misleading) *)
Expand Down Expand Up @@ -494,7 +498,7 @@ let sync_exercise token ?answer ?editor id =
} in
match token with
| Some token ->
Lwt.catch (fun () -> sync_save token save_file)
Lwt.catch (fun () -> sync_save token save_file on_sync)
(fun e ->
handle_serverless ();
raise e)
Expand Down Expand Up @@ -708,11 +712,72 @@ let mouseover_toggle_signal elt sigvalue setter =
in
Manip.Ev.onmouseover elt hdl
(*
If a user has made no change to a solution for the exercise [id]
for 180 seconds, [check_valid_editor_state id] ensures that there is
no more recent version of this solution in the server. If this is
the case, the user is asked if we should download this solution
from the server.
This function reduces the risk of an involuntary overwriting of a
student solution when the solution is open in several clients.
*)
let is_synchronized_with_server_callback = ref (fun () -> false)
let is_synchronized_with_server () = !is_synchronized_with_server_callback ()
let check_valid_editor_state id =
let last_changed = ref (Unix.gettimeofday ()) in
fun update_content focus_back on_sync ->
let update_local_copy checking_time () =
let get_solution () =
Learnocaml_local_storage.(retrieve (exercise_state id)).Answer.solution in
try let mtime =
Learnocaml_local_storage.(retrieve (exercise_state id)).Answer.mtime in
if mtime > checking_time then begin
let buttons =
if is_synchronized_with_server () then
[
[%i "Fetch from server"],
(fun () -> let solution = get_solution () in
Lwt.return (focus_back (); update_content solution; on_sync ()));
[%i "Ignore & keep editing"],
(fun () -> Lwt.return (focus_back ()));
]
else
[
[%i "Ignore & keep editing"],
(fun () -> Lwt.return (focus_back ()));
[%i "Fetch from server & overwrite"],
(fun () -> let solution = get_solution () in
Lwt.return (focus_back (); update_content solution; on_sync ()));
]
in
lwt_alert ~title:"Question"
~buttons
[ H.p [H.txt [%i "A more recent answer exists on the server. \
Do you want to fetch the new version?"] ] ]
end else Lwt.return_unit
with
| Not_found -> Lwt.return ()
in
let now = Unix.gettimeofday () in
if now -. !last_changed > 180. then (
let checking_time = !last_changed in
last_changed := now;
Lwt.async (update_local_copy checking_time)
) else
last_changed := now
let ace_display tab =
let ace = lazy (
let answer =
Ocaml_mode.create_ocaml_editor
(Tyxml_js.To_dom.of_div tab)
(fun _ _ _ -> ())
in
let ace = Ocaml_mode.get_editor answer in
Ace.set_font_size ace 16;
Expand Down Expand Up @@ -874,7 +939,8 @@ end
module Editor_button (E : Editor_info) = struct
let editor_button = button ~container:E.buttons_container ~theme:"light"
let editor_button =
button ~container:E.buttons_container ~theme:"light"
let cleanup template =
editor_button
Expand All @@ -901,16 +967,26 @@ module Editor_button (E : Editor_info) = struct
select_tab "toplevel";
Lwt.return_unit
let sync token id =
editor_button
let sync token id on_sync =
let state = button_state () in
(editor_button
~state
~icon: "sync" [%i"Sync"] @@ fun () ->
token >>= fun token ->
sync_exercise token id ~editor:(Ace.get_contents E.ace) >|= fun _save -> ()
sync_exercise token id ~editor:(Ace.get_contents E.ace) on_sync
>|= fun _save -> ());
Ace.register_sync_observer E.ace (fun sync ->
if sync then disable_button state else enable_button state)
end
let setup_editor solution =
let setup_editor id solution =
let editor_pane = find_component "learnocaml-exo-editor-pane" in
let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in
let editor =
Ocaml_mode.create_ocaml_editor
(Tyxml_js.To_dom.of_div editor_pane)
(check_valid_editor_state id)
in
let ace = Ocaml_mode.get_editor editor in
Ace.set_contents ace ~reset_undo:true solution;
Ace.set_font_size ace 18;
Expand Down Expand Up @@ -1022,7 +1098,7 @@ let setup_prelude_pane ace prelude =
(fun _ -> state := not !state ; update () ; true) ;
Manip.appendChildren prelude_pane
[ prelude_title ; prelude_container ]
let get_token ?(has_server = true) () =
if not has_server then
Lwt.return None
Expand All @@ -1041,7 +1117,7 @@ let get_token ?(has_server = true) () =
>|= fun token ->
Learnocaml_local_storage.(store sync_token) token;
Some token
module Display_exercise =
functor (
Q: sig
Expand Down
20 changes: 13 additions & 7 deletions src/app/learnocaml_common.mli
Expand Up @@ -119,18 +119,22 @@ val set_state_from_save_file :
(** Gets a save file containing the locally stored data *)
val get_state_as_save_file : ?include_reports:bool -> unit -> Save.t

(** Sync the local save state with the server state, and returns the merged save
file. The save will be created on the server if it doesn't exist.
(**
[sync token on_sync] synchronizes the local save state with the server state,
and returns the merged save file. The save will be created on the server
if it doesn't exist. [on_sync ()] is called when this is done.
This syncs student {b content}, but never the reports which are only synched
on "Grade" *)
val sync: Token.t -> Save.t Lwt.t
Notice that this function synchronizes student {b,content} but not the
reports which are only synchronized when an actual "grading" is done.
*)
val sync: Token.t -> (unit -> unit) -> Save.t Lwt.t

(** The same, but limiting the submission to the given exercise, using the given
answer if any, and the given editor text, if any. *)
val sync_exercise:
Token.t option -> ?answer:Learnocaml_data.Answer.t -> ?editor:string ->
Learnocaml_data.Exercise.id ->
(unit -> unit) ->
Save.t Lwt.t

val countdown:
Expand Down Expand Up @@ -211,10 +215,12 @@ module Editor_button (_ : Editor_info) : sig
val cleanup : string -> unit
val download : string -> unit
val eval : Learnocaml_toplevel.t -> (string -> unit) -> unit
val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> unit
val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> (unit -> unit) -> unit
end

val setup_editor : string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor
val setup_editor : string -> string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor

val is_synchronized_with_server_callback : (unit -> bool) ref

val typecheck :
Learnocaml_toplevel.t ->
Expand Down

0 comments on commit 5c12539

Please sign in to comment.