load data/assets/terms/..

unikernel/unikernel.ml

@@ -39,6 +39,62 @@ module Make
     (Connect : Connect.S)
     (HTTP_server : Paf_mirage.S) =
 struct
+  (* WIP
+     read directories *)
+  module Assets = struct
+    module Assets_ro = Keys_ro
+
+    let ( let*? ) = Lwt_result.bind
+    let ( let+? ) x f = Lwt_result.map f x
+    let map_err_to_string = map_err_to_string Assets_ro.pp_error
+
+    let get_subdirs ro k =
+      let+? keys = Assets_ro.list ro k |> map_err_to_string in
+      List.filter (fun (_, t) -> t = `Dictionary) keys |> List.map fst
+
+    let get_values ro k =
+      let+? keys = Assets_ro.list ro k |> map_err_to_string in
+      List.filter (fun (_, t) -> t = `Value) keys |> List.map fst
+
+    let find keys name =
+      keys
+      |> List.find_opt Mirage_kv.Key.(equal (v name))
+      |> Option.to_result ~none:(`Msg (Fmt.str "missing `%s` directory" name))
+      |> Lwt_result.lift
+
+    let lwt_list_get_ok l =
+      let open Lwt.Syntax in
+      let+ l = l in
+      let err = ref None in
+      try
+        l
+        |> List.map (function
+          | Error _e as e ->
+              err := Some e;
+              raise Exit
+          | Ok v -> v)
+        |> Result.ok
+      with Exit -> ( match !err with None -> assert false | Some v -> v)
+
+    let get ro s =
+      let*? base_dir = get_subdirs ro Mirage_kv.Key.empty in
+      let*? dir = find base_dir s in
+      let*? subdirs = get_subdirs ro dir in
+      let+? l =
+        subdirs
+        |> Lwt_list.map_s (fun lang_dir ->
+            let+? files = get_values ro lang_dir in
+            (lang_dir, files))
+        |> lwt_list_get_ok
+      in
+      l
+
+    let assets ro =
+      let*? terms_assoc = get ro "terms" in
+      let+? privacy_assoc = get ro "privacy" in
+      (terms_assoc, privacy_assoc)
+  end
+
   let tls certificate_ro key_ro =
     let ( >>= ) = Lwt_result.bind in
     Keys_ro.list key_ro Mirage_kv.Key.empty