WIP

Author: erikmd

src/state/dune

@@ -40,5 +40,5 @@
  (name learnocaml_store)
  (wrapped false)
  (modules Learnocaml_store)
- (libraries cryptokit lwt_utils learnocaml_api)
+ (libraries cryptokit lwt_utils learnocaml_api irmin irmin-git irmin-git.unix)
 )

src/state/learnocaml_store.ml

@@ -299,7 +299,7 @@ module Exercise = struct
 
 end
 
-module Session = struct
+module Session1 = struct
 
   include Session
 
@@ -348,6 +348,110 @@ module Session = struct
 
 end
 
+module Session = struct
+
+  include Session
+
+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 *)
+(* objectif 1: explorer la doc des différents modules ci-dessous,
+   avec C-c C-l, C-c C-a et dans le browser:
+   https://ocaml.org/p/irmin-git/latest/doc/Irmin_git/index.html
+   https://github.com/mirage/irmin/blob/main/examples/irmin_git_store.ml
+   objectif 2 : refactorer le code ci-dessous commenté
+   pour utiliser Store.set_exn au lieu du Json_encoding.obj3...
+ *)
+  module Store = Irmin_git.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
+
+  (* let file = "sessions.json" *)
+
+  (* let enc = *)
+  (*   let open Json_encoding in *)
+  (*   list (obj3 *)
+  (*     (req "session" Session.enc) *)
+  (*     (req "token" Token.enc) *)
+  (*     (req "last_connection" float)) *)
+
+  (* let path dir = Filename.concat dir file *)
+
+  (* let load dir = *)
+  (*   let p = path dir in *)
+  (*   Lwt_unix.file_exists dir >>= fun dir_exists -> *)
+  (*   (if not dir_exists then Lwt_unix.mkdir dir 0o700 else Lwt.return_unit) >>= fun () -> *)
+  (*   Lwt_unix.file_exists p >>= function *)
+  (*   | false -> *)
+  (*       Printf.printf "No session file, creating empty list\n%!"; *)
+  (*       Lwt.return [] *)
+  (*   | true -> *)
+  (*       Printf.printf "Loading sessions from: %s\n%!" p; *)
+  (*       get_from_file enc p *)
+
+  (* let save dir table = *)
+  (*   write_to_file enc table (path dir) *)
+
+  (* let get_user_token session = *)
+  (*   load !data_dir >>= fun table -> *)
+  (*   match List.find_opt (fun (s, _, _) -> s = session) table with *)
+  (*   | Some (_, token, _) -> Lwt.return_some token *)
+  (*   | None -> Lwt.return_none *)
+
+  (* let set_session session token = *)
+  (*   let now = Unix.gettimeofday () in *)
+  (*   load !data_dir >>= fun table -> *)
+  (*   let table = (session, token, now) :: table in *)
+  (*   save !data_dir table *)
+
+  (* let gen_session () = *)
+  (*   let len = 32 in *)
+  (*   Cryptokit.Random.string Cryptokit.Random.secure_rng len *)
+  (* |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () *)
+
+end
+
 module Token = struct
 
   include Token