+ wip read data/assets/..
This commit is contained in:
parent
348f6beb0f
commit
9440812f12
1 changed files with 49 additions and 0 deletions
|
|
@ -39,6 +39,55 @@ module Make
|
||||||
(Connect : Connect.S)
|
(Connect : Connect.S)
|
||||||
(HTTP_server : Paf_mirage.S) =
|
(HTTP_server : Paf_mirage.S) =
|
||||||
struct
|
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 tls certificate_ro key_ro =
|
||||||
let ( >>= ) = Lwt_result.bind in
|
let ( >>= ) = Lwt_result.bind in
|
||||||
Keys_ro.list key_ro Mirage_kv.Key.empty
|
Keys_ro.list key_ro Mirage_kv.Key.empty
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue