diff --git a/dune-project b/dune-project index d2ec6b924..567808f08 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.3) +(lang dune 3.6) (name learn-ocaml) (version 0.14.1) (allow_approximate_merlin) diff --git a/learn-ocaml.opam b/learn-ocaml.opam index e0d6e4584..38b8523d0 100644 --- a/learn-ocaml.opam +++ b/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" diff --git a/src/state/dune b/src/state/dune index 2f37a386d..abade6a59 100644 --- a/src/state/dune +++ b/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) ) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 3d10c0f2e..1596792fc 100644 --- a/src/state/learnocaml_store.ml +++ b/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 diff --git a/src/state/learnocaml_token_index.ml b/src/state/learnocaml_token_index.ml new file mode 100644 index 000000000..384c74e96 --- /dev/null +++ b/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