Offer better protections against solution overwriting

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