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 <[email protected]>
Co-authored-by: Erik Martin-Dorel <[email protected]>

Author: yurug

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
@@ -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"
@@ -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
@@ -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
@@ -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 =

src/ace-lib/ace.mli

@@ -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
 

src/ace-lib/ocaml_mode.ml

@@ -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

src/ace-lib/ocaml_mode.mli

@@ -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

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
@@ -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) *)
@@ -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)
@@ -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;
@@ -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
@@ -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;
@@ -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
@@ -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

src/app/learnocaml_common.mli

@@ -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:
@@ -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 ->