Fix static deployment

learn-ocaml.opam

@@ -39,6 +39,7 @@ depends: [
   "ssl" {= "0.5.5"}
   "magic-mime"
   "markup"
+  "markup-lwt"
   "ocaml" {= "4.05.0"}
   "ocamlfind" {build}
   "ocp-indent-nlfork"

learn-ocaml.opam.locked

@@ -59,6 +59,7 @@ depends: [
   "js_of_ocaml-toplevel" {= "3.3.0"}
   "js_of_ocaml-tyxml" {= "3.3.0"}
   "jsonm" {= "1.0.1"}
+  "markup-lwt" {= "0.5.0"}
   "logs" {= "0.7.0"}
   "lwt" {= "4.2.1"}
   "lwt_react" {= "1.1.3"}

src/app/dune

@@ -3,10 +3,12 @@
  (wrapped false)
  (flags :standard -warn-error -9-27-32)
  (modules Learnocaml_local_storage
+          Learnocaml_config
           Server_caller
           Learnocaml_common)
  (preprocess
   (per_module ((pps js_of_ocaml.ppx)
+               Learnocaml_config
                Learnocaml_local_storage
                Server_caller)
               ((pps ppx_ocplib_i18n js_of_ocaml.ppx)

src/app/learnocaml_common.ml

@@ -10,6 +10,7 @@ open Js_of_ocaml
 open Js_utils
 open Lwt.Infix
 open Learnocaml_data
+open Learnocaml_config
 
 module H = Tyxml_js.Html
 
@@ -172,7 +173,7 @@ let show_loading ?(id = "ocp-loading-layer") contents f =
     Manip.(removeClass elt "loaded") ;
     Manip.(addClass elt "loading") ;
     let chamo_src =
-      "/icons/tryocaml_loading_" ^ string_of_int (Random.int 9 + 1) ^ ".gif" in
+      api_server ^ "/icons/tryocaml_loading_" ^ string_of_int (Random.int 9 + 1) ^ ".gif" in
     Manip.replaceChildren elt
       H.[
         div ~a: [ a_id "chamo" ] [ img ~alt: "loading" ~src: chamo_src () ] ;
@@ -287,7 +288,7 @@ let button ~container ~theme ?group ?state ~icon lbl cb =
     | Some group -> group in
   let button =
     H.(button [
-        img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ;
+        img ~alt:"" ~src:(api_server ^ "/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ;
         txt " " ;
         span ~a:[ a_class [ "label" ] ] [ txt lbl ]
       ]) in
@@ -386,7 +387,7 @@ let extract_text_from_rich_text text =
 let set_state_from_save_file ?token save =
   let open Learnocaml_data.Save in
   let open Learnocaml_local_storage in
-  match token with None -> () | Some t -> store sync_token t;
+  (match token with None -> () | Some t -> store sync_token t);
   store nickname save.nickname;
   store all_exercise_states
     (SMap.merge (fun _ ans edi ->
@@ -455,6 +456,24 @@ let rec sync_save token save_file =
 let sync token = sync_save token (get_state_as_save_file ())
 
 let sync_exercise token ?answer ?editor id =
+  let handle_serverless () =
+    (* save the text at least locally (but not the report & grade, that could
+       be misleading) *)
+    let txt = match editor, answer with
+      | Some t, _ -> Some t
+      | _, Some a -> Some a.Answer.solution
+      | _ -> None
+    in
+    match txt with
+    | Some txt ->
+       let key = Learnocaml_local_storage.exercise_state id in
+       let a0 = Learnocaml_local_storage.retrieve key in
+       Learnocaml_local_storage.store key
+         {a0 with Answer.
+          solution = txt;
+          mtime = gettimeofday () }
+    | None -> ()
+  in
   let nickname = Learnocaml_local_storage.(retrieve nickname) in
   let toplevel_history =
     SMap.find_opt id Learnocaml_local_storage.(retrieve all_toplevel_histories)
@@ -471,26 +490,15 @@ let sync_exercise token ?answer ?editor id =
     all_toplevel_histories = SMap.empty;
     all_exercise_toplevel_histories = opt_to_map toplevel_history;
   } in
-  Lwt.catch (fun () -> sync_save token save_file)
-    (fun e ->
-       (* save the text at least locally (but not the report & grade, that could
-          be misleading) *)
-       let txt = match editor, answer with
-         | Some t, _ -> Some t
-         | _, Some a -> Some a.Answer.solution
-         | _ -> None
-       in
-       (match txt with
-        | Some txt ->
-            let key = Learnocaml_local_storage.exercise_state id in
-            let a0 = Learnocaml_local_storage.retrieve key in
-            Learnocaml_local_storage.store key
-              {a0 with Answer.
-                    solution = txt;
-                    mtime = gettimeofday () }
-        | None -> ());
-       raise e)
-
+  match token with
+  | Some token ->
+     Lwt.catch (fun () -> sync_save token save_file)
+       (fun e ->
+         handle_serverless ();
+         raise e)
+  | None -> set_state_from_save_file save_file;
+            handle_serverless ();
+            Lwt.return save_file
 
 let string_of_seconds seconds =
   let days = seconds / 24 / 60 / 60 in
@@ -531,13 +539,13 @@ let stars_div stars =
     let num = 5 * int_of_float (stars *. 2.) in
     let num = max (min num 40) 0 in
     let alt = Format.asprintf [%if"difficulty: %d / 40"] num in
-    let src = Format.asprintf "/icons/stars_%02d.svg" num in
+    let src = Format.asprintf "%s/icons/stars_%02d.svg" api_server num in
     H.img ~alt ~src ()
   ]
 
 let exercise_text ex_meta exo =
   let mathjax_url =
-    "/js/mathjax/MathJax.js?delayStartupUntil=configured"
+    api_server ^ "/js/mathjax/MathJax.js?delayStartupUntil=configured"
   in
   let mathjax_config =
     "MathJax.Hub.Config({\n\
@@ -572,7 +580,7 @@ let exercise_text ex_meta exo =
      <html><head>\
      <title>%s - exercise text</title>\
      <meta charset='UTF-8'>\
-     <link rel='stylesheet' href='/css/learnocaml_standalone_description.css'>\
+     <link rel='stylesheet' href='%s/css/learnocaml_standalone_description.css'>\
      <script type='text/x-mathjax-config'>%s</script>
             <script type='text/javascript' src='%s'></script>\
      </head>\
@@ -582,6 +590,7 @@ let exercise_text ex_meta exo =
      <script type='text/javascript'>MathJax.Hub.Configured()</script>\
      </html>"
     ex_meta.Exercise.Meta.title
+    api_server
     mathjax_config
     mathjax_url
     descr
@@ -970,23 +979,26 @@ let setup_prelude_pane ace prelude =
     (fun _ -> state := not !state ; update () ; true) ;
   Manip.appendChildren prelude_pane
     [ prelude_title ; prelude_container ]
-
-let get_token () =
-  try
-    Learnocaml_local_storage.(retrieve sync_token) |>
-      Lwt.return
-  with Not_found ->
-    retrieve (Learnocaml_api.Nonce ())
-    >>= fun nonce ->
-    ask_string ~title:"Secret"
-      [H.txt [%i"Enter the secret"]]
-    >>= fun secret ->
-    retrieve
-      (Learnocaml_api.Create_token (Sha.sha512 (nonce ^ Sha.sha512 secret), None, None))
-    >|= fun token ->
-    Learnocaml_local_storage.(store sync_token) token;
-    token
-
+
+let get_token ?(has_server = true) () =
+  if not has_server then
+    Lwt.return None
+  else
+    try
+      Some Learnocaml_local_storage.(retrieve sync_token) |>
+        Lwt.return
+    with Not_found ->
+      retrieve (Learnocaml_api.Nonce ())
+      >>= fun nonce ->
+      ask_string ~title:"Secret"
+        [H.txt [%i"Enter the secret"]]
+      >>= fun secret ->
+      retrieve
+        (Learnocaml_api.Create_token (Sha.sha512 (nonce ^ Sha.sha512 secret), None, None))
+      >|= fun token ->
+      Learnocaml_local_storage.(store sync_token) token;
+      Some token
+
 module Display_exercise =
   functor (
     Q: sig
@@ -1014,7 +1026,7 @@ module Display_exercise =
         let num = 5 * int_of_float (ex_meta.Meta.stars *. 2.) in
         let num = max (min num 40) 0 in
         let alt = Format.asprintf [%if"difficulty: %d / 40"] num in
-        let src = Format.asprintf "/icons/stars_%02d.svg" num in
+        let src = Format.asprintf "%s/icons/stars_%02d.svg" api_server num in
         img ~alt ~src ()
       in
       div ~a:[ a_class [ "stars" ] ] [
@@ -1062,7 +1074,7 @@ module Display_exercise =
 
     let get_skill_index token =
       let index = lazy (
-                      retrieve (Learnocaml_api.Exercise_index token)
+                      retrieve (Learnocaml_api.Exercise_index (Some token))
     >|= fun (index, _) ->
                       Exercise.Index.fold_exercises (fun (req, focus) id meta ->
                           let add sk id map =

src/app/learnocaml_common.mli

@@ -128,7 +128,7 @@ val sync: Token.t -> 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 -> ?answer:Learnocaml_data.Answer.t -> ?editor:string ->
+  Token.t option -> ?answer:Learnocaml_data.Answer.t -> ?editor:string ->
   Learnocaml_data.Exercise.id ->
   Save.t Lwt.t
 
@@ -209,8 +209,8 @@ end
 module Editor_button (E : Editor_info) : sig
   val cleanup : string -> unit
   val download : string -> unit
-  val eval : Learnocaml_toplevel.t -> (string -> unit) -> unit
-  val sync : Token.t Lwt.t -> Learnocaml_data.SMap.key -> unit
+  val eval : Learnocaml_toplevel.t -> (string -> 'a) -> unit
+  val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> unit
 end
 
 val setup_editor : string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor
@@ -223,7 +223,7 @@ val set_nickname_div : unit -> unit
 
 val setup_prelude_pane : 'a Ace.editor -> string -> unit
 
-val get_token : unit -> Learnocaml_data.student Learnocaml_data.token Lwt.t
+val get_token : ?has_server:bool -> unit -> Learnocaml_data.student Learnocaml_data.token option Lwt.t
 
 module Display_exercise :functor
   (Q : sig
@@ -274,6 +274,6 @@ module Display_exercise :functor
       (string Tyxml_js.Html5.wrap * string Tyxml_js.Html5.wrap) list ->
       [> `PCDATA | `Span ] Tyxml_js.Html5.elt list
     val display_meta :
-      'a Learnocaml_data.token ->
+      'a Learnocaml_data.token option ->
       Learnocaml_data.Exercise.Meta.t -> string -> unit Lwt.t
   end

src/app/learnocaml_config.ml

@@ -0,0 +1,20 @@
+(* This file is part of Learn-OCaml
+ *
+ * Copyright (C) 2020 Alban Gruin.
+ *
+ * Learn-OCaml is distributed under the terms of the MIT license. See the
+ * included LICENSE file for details.  *)
+
+class type learnocaml_config = object
+  method enableTryocaml: bool Js.optdef_prop
+  method enableLessons: bool Js.optdef_prop
+  method enableExercises: bool Js.optdef_prop
+  method enableToplevel: bool Js.optdef_prop
+  method enablePlayground: bool Js.optdef_prop
+  method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop
+  method txtNickname: Js.js_string Js.t Js.optdef_prop
+  method root: Js.js_string Js.t Js.optdef_prop
+end
+
+let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config"
+let api_server = Js.(to_string (Optdef.get config##.root (fun () -> string "")))

src/app/learnocaml_config.mli

@@ -0,0 +1,24 @@
+(* This file is part of Learn-OCaml
+ *
+ * Copyright (C) 2020 Alban Gruin.
+ *
+ * Learn-OCaml is distributed under the terms of the MIT license. See the
+ * included LICENSE file for details.  *)
+
+(* This is not transpiled to learnocaml-static.js, but is an interface
+   to the values stored in this file.  It is "statically linked" with
+   learnocaml-common.ml. *)
+
+class type learnocaml_config = object
+  method enableTryocaml: bool Js.optdef_prop
+  method enableLessons: bool Js.optdef_prop
+  method enableExercises: bool Js.optdef_prop
+  method enableToplevel: bool Js.optdef_prop
+  method enablePlayground: bool Js.optdef_prop
+  method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop
+  method txtNickname: Js.js_string Js.t Js.optdef_prop
+  method root: Js.js_string Js.t Js.optdef_prop
+end
+
+val config : learnocaml_config Js.t
+val api_server : string

src/app/learnocaml_description_main.ml

@@ -30,7 +30,7 @@ let () =
      try begin
          let token = Learnocaml_data.Token.parse (arg "token") in
          let exercise_fetch =
-           retrieve (Learnocaml_api.Exercise (token, id))
+           retrieve (Learnocaml_api.Exercise (Some token, id))
          in
          init_tabs ();
          exercise_fetch >>= fun (ex_meta, exo, _deadline) ->
@@ -47,7 +47,7 @@ let () =
              d##write (Js.string (exercise_text ex_meta exo));
              d##close) ;
          (* display meta *)
-         display_meta token ex_meta id
+         display_meta (Some token) ex_meta id
        end
      with Not_found ->
        Lwt.return @@