unikernel/unikernel.ml

@@ -39,6 +39,55 @@ 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 map_err_to_string = map_err_to_string Assets_ro.pp_error
+
+    let get_dir l name =
+      l
+      |> List.find_opt (fun (k, t) ->
+          Mirage_kv.Key.(equal (v name) k) && t = `Dictionary)
+      |> Option.map fst
+      |> Option.to_result ~none:(`Msg (Fmt.str "missing `%s` directory" name))
+      |> Lwt_result.lift
+
+    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
+      |> Lwt_result.return
+
+    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
+      |> Lwt_result.return
+
+    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 assets ro =
+      let*$ base_dir = get_subdirs ro Mirage_kv.Key.empty in
+      let*$ terms_dir = find base_dir "terms" in
+      let*$ privacy_dir = find base_dir "privacy" in
+      let*$ terms_subdirs = get_subdirs ro terms_dir in
+      let*$ privacy_subdirs = get_subdirs ro privacy_dir in
+      let*$ _terms_files =
+        terms_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok
+      in
+      let*$ _privacy_files =
+        privacy_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok
+      in
+      Lwt_result.return ()
+  end
+
   let tls certificate_ro key_ro =
     let ( >>= ) = Lwt_result.bind in
     Keys_ro.list key_ro Mirage_kv.Key.empty