Implementation of the file token_index

dune-project

@@ -1,4 +1,4 @@
-(lang dune 2.3)
+(lang dune 3.6)
 (name learn-ocaml)
 (version 0.14.1)
 (allow_approximate_merlin)

learn-ocaml.opam

@@ -31,6 +31,7 @@ depends: [
   "easy-format" {>= "1.3.0" }
   "ezjsonm"
   "ipaddr" {= "2.9.0" }
+  "irmin" {= "3.7.1" }
   "js_of_ocaml" {>= "3.3.0" & != "3.10.0"}
   "js_of_ocaml-compiler" {>= "3.3.0"}
   "js_of_ocaml-lwt"

src/state/dune

@@ -26,9 +26,16 @@
             learnocaml_data)
 )
 
+(library
+ (name learnocaml_token_index)
+ (wrapped false)
+ (modules Learnocaml_token_index)
+ (libraries lwt lwt.unix lwt_utils learnocaml_api learnocaml_data cryptokit safepass irmin irmin-git irmin-git.unix)
+)
+
 (library
  (name learnocaml_store)
  (wrapped false)
  (modules Learnocaml_store)
- (libraries lwt_utils learnocaml_api)
+ (libraries learnocaml_token_index lwt_utils learnocaml_api)
 )

src/state/learnocaml_store.ml

@@ -8,6 +8,7 @@
 
 open Lwt.Infix
 open Learnocaml_data
+open Learnocaml_token_index
 
 module J = Json_encoding
 
@@ -340,7 +341,7 @@ module Token = struct
       | Unix.Unix_error (Unix.EEXIST, _, _) -> aux ()
       | e -> Lwt.fail e
     in
-    aux ()
+    aux () >>= fun t -> TokenIndex.add_token !sync_dir t >|= fun _ -> t
 
   let register ?(allow_teacher=false) token =
     if not allow_teacher && is_teacher token then
@@ -384,32 +385,7 @@ module Token = struct
 
     let enc = J.(list enc)
 
-    let get () =
-      let base = !sync_dir in
-      let ( / ) dir f = if dir = "" then f else Filename.concat dir f in
-      let rec scan f d acc =
-        let rec aux s acc =
-          Lwt.catch (fun () ->
-              Lwt_stream.get s >>= function
-              | Some ("." | "..") -> aux s acc
-              | Some x -> scan f (d / x) acc >>= aux s
-              | None -> Lwt.return acc)
-          @@ function
-          | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc
-          | Unix.Unix_error _ -> Lwt.return acc
-          | e -> Lwt.fail e
-        in
-        aux (Lwt_unix.files_of_directory (base / d)) acc
-      in
-      scan (fun d acc ->
-          let d =
-            if Filename.basename d = "save.json" then Filename.dirname d
-            else d
-          in
-          let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in
-          try Lwt.return (Token.parse stok :: acc)
-          with Failure _ -> Lwt.return acc
-        ) "" []
+    let get () = TokenIndex.get_tokens !sync_dir
 
   end
 

src/state/learnocaml_token_index.ml

@@ -0,0 +1,65 @@
+(* This file is part of Learn-OCaml.
+ *
+ * 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
+ * included LICENSE file for details. *)
+
+open Lwt
+open Learnocaml_data
+open Lwt.Syntax
+
+let ( / ) dir f = if dir = "" then f else Filename.concat dir f
+let sync_dir = "sync"
+let indexes_subdir = "data"
+
+let logfailwith str arg =
+  Printf.printf "[ERROR] %s (%s)\n%!" str arg;
+  failwith str
+
+let generate_random_hex len =
+  Cryptokit.Random.string Cryptokit.Random.secure_rng len
+  |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode ()
+
+module type IndexKV  = functor (Store: Irmin.S) -> sig
+  type token = Learnocaml_data.Token.t
+  type t
+
+  val parse : [> `O of (string * [> `String of 'a ]) list ] -> 'a
+  val serialise : 'a -> [> `O of (string * [> `String of 'a ]) list ]
+  val read :
+    Store.path list -> (Store.contents -> 'a) -> string -> 'a list Lwt.t
+  val write :
+    Store.path list ->
+    ('a -> Store.contents) -> 'a list -> string -> unit Lwt.t
+  val create_index : string -> unit Lwt.t
+  val exists : t
+  val remove : t
+end
+
+module AUTH: IndexKV = struct
+
+  module Store = Irmin_mem.KV.Make(Irmin.Contents.Json_value)
+  module Info = Irmin_unix.Info(Store.Info)
+
+  let read keys parse path=
+    let config = Irmin_git.config ~bare:true path in
+    let* repo = Store.Repo.v config in
+    let* t = Store.main repo in
+    Lwt_list.map_p
+      (fun key ->
+        let+ x = Store.get t key in parse x)
+      keys
+
+  let write keys serialise data_list path=
+    let config = Irmin_git.config ~bare:true path in
+    let* repo = Store.Repo.v config in
+    let* t = Store.main repo in
+    Lwt_list.iter_p
+      (fun (key,data) ->
+        Store.set_exn t ~info:(Info.v "message") key
+          (*deal with the errors if using `set` instead of `set_exn`*)
+          (serialise data))
+    @@ List.combine keys data_list
+end