Offer better protections again solution overwriting

Signed-off-by: Yann Regis-Gianas <yann@regis-gianas.org>

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-2020 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
@@ -71,15 +76,34 @@ let get_line {editor} line =
   let document = (editor##getSession)##getDocument in
   Js.to_string @@ document##(getLine line)
 
-let create_editor editor_div =
+let set_synchronized_status editor status =
+  List.iter (fun obs -> obs status) editor.sync_observers;
+  editor.synchronized <- status
+
+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) ;
+      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

src/ace-lib/ace.mli

@@ -17,7 +17,13 @@ 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) -> '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

@@ -506,8 +506,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

@@ -25,7 +25,7 @@ type warning = {
   msg: string;
 }
 
-val create_ocaml_editor: Dom_html.divElement Js.t -> editor
+val create_ocaml_editor: Dom_html.divElement Js.t -> ((string -> 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
@@ -432,30 +432,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) *)
@@ -492,7 +496,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)
@@ -706,11 +710,48 @@ 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 check_valid_editor_state id =
+  let last_changed = ref (Unix.gettimeofday ()) in
+  fun update_content ->
+  let update_local_copy checking_time () =
+    match Learnocaml_local_storage.(retrieve (exercise_state id)) with
+    | { Answer.mtime; solution; _ } ->
+       if mtime > checking_time then (
+         if Js_utils.confirm
+              [%i "A more recent answer exists on the server. \
+                   Do you want to update the current one?"]
+         then
+           update_content solution;
+       );
+       Lwt.return ()
+    | exception 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)
+  )
+
+
 let ace_display tab =
   let ace = lazy (
     let answer =
       Ocaml_mode.create_ocaml_editor
         (Tyxml_js.To_dom.of_div tab)
+        ignore
     in
     let ace = Ocaml_mode.get_editor answer in
     Ace.set_font_size ace 16;
@@ -872,7 +913,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
@@ -898,16 +940,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;

src/app/learnocaml_common.mli

@@ -118,18 +118,23 @@ 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:
@@ -210,10 +215,10 @@ module Editor_button (E : Editor_info) : sig
   val cleanup : string -> unit
   val download : string -> unit
   val eval : Learnocaml_toplevel.t -> (string -> 'a) -> 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 typecheck :
   Learnocaml_toplevel.t ->

src/app/learnocaml_exercise_main.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
@@ -177,10 +177,10 @@ let () =
     Tyxml_js.Html5.[ h1 [ txt ex_meta.Exercise.Meta.title ] ;
                      Tyxml_js.Of_dom.of_iFrame text_iframe ] ;
   (* ---- editor pane --------------------------------------------------- *)
-  let editor, ace = setup_editor solution in
+  let editor, ace = setup_editor id solution in
   let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
   EB.cleanup (Learnocaml_exercise.(access File.template exo));
-  EB.sync token id;
+  EB.sync token id (fun () -> Ace.set_synchronized ace) ;
   EB.download id;
   EB.eval top select_tab;
   let typecheck = typecheck top ace editor in
@@ -264,7 +264,8 @@ let () =
             Some solution, None
         in
         token >>= fun token ->
-        sync_exercise token id ?answer ?editor >>= fun _save ->
+        sync_exercise token id ?answer ?editor (fun () -> Ace.set_synchronized ace)
+        >>= fun _save ->
         select_tab "report" ;
         Lwt_js.yield () >>= fun () ->
         Ace.focus ace ;
@@ -283,7 +284,7 @@ let () =
         Ace.focus ace ;
         typecheck true
   end ;
-  Window.onunload (fun _ev -> local_save ace id; true);
+  Window.onbeforeunload (fun _ -> (not (Ace.is_synchronized ace), false));
   (* ---- return -------------------------------------------------------- *)
   toplevel_launch >>= fun _ ->
   typecheck false >>= fun () ->

src/app/learnocaml_index_main.ml

@@ -811,7 +811,7 @@ let () =
           Lwt.return_unit);
       [%i"Sync workspace"], "sync", (fun () ->
           catch_with_alert @@ fun () ->
-          sync () >>= fun _ -> Lwt.return_unit);
+          sync () ignore >>= fun _ -> Lwt.return_unit);
       [%i"Export to file"], "download", download_save;
       [%i"Import"], "upload", import_save;
       [%i"Download all source files"], "download", download_all;

src/app/learnocaml_playground_main.ml

@@ -26,8 +26,12 @@ let main () =
   disable_button_group toplevel_buttons_group (* enabled after init *) ;
   let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in
   let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in
-  let toplevel_button =
-    button ~container: toplevel_toolbar ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
+  let toplevel_button ~icon label cb =
+    ignore @@
+      button
+        ~icon ~container: toplevel_toolbar
+        ~theme: "dark" ~group:toplevel_buttons_group ?state:None label cb
+  in
   let id = match Url.Current.path with
     | "" :: "playground" :: p | "playground" :: p ->
         String.concat "/" (List.map Url.urldecode (List.filter ((<>) "") p))
@@ -59,7 +63,7 @@ let main () =
   (* ---- toplevel pane ------------------------------------------------- *)
   init_toplevel_pane toplevel_launch top toplevel_buttons_group toplevel_button ;
   (* ---- editor pane --------------------------------------------------- *)
-  let editor, ace = setup_editor solution in
+  let editor, ace = setup_editor id solution in
   let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
   EB.cleanup playground.Playground.template;
   EB.download id;

src/utils/js_utils.ml

@@ -1143,6 +1143,16 @@ module Window = struct
   let head win = Tyxml_js.Of_dom.of_head win##.document##.head
   let onunload ?(win = Dom_html.window) f =
     win##.onunload := Dom_html.handler (fun ev -> Js.bool (f ev))
+  let onbeforeunload ?(win = Dom_html.window) f =
+    win##.onbeforeunload := Dom_html.handler (fun ev ->
+                                let (status, propagate) = f ev in
+                                if status then (
+                                   Js.bool propagate
+                                ) else
+                                  (
+                                    Js.(Unsafe.eval_string "undefined");
+                                  )
+                             )
   let onresize ?(win = Dom_html.window) f =
     win##.onresize := Dom_html.handler (fun ev -> Js.bool (f ev))
   let prompt ?(win = Dom_html.window) ?(value = "") msg =

src/utils/js_utils.mli

@@ -381,6 +381,9 @@ module Window : sig
   val onunload:
     ?win:Dom_html.window Js.t ->
     (Dom_html.event Js.t -> bool) -> unit
+  val onbeforeunload:
+    ?win:Dom_html.window Js.t ->
+    (Dom_html.event Js.t -> bool * bool) -> unit
   val onhashchange:
     ?win:Dom_html.window Js.t ->
     (Dom_html.hashChangeEvent Js.t -> bool) -> unit