This commit is contained in:
swrup 2025-11-03 09:16:29 +01:00
parent 9ffe546aa5
commit 63497dbc5c

View file

@ -43,6 +43,7 @@ struct
read directories *)
module Assets = struct
module Assets_ro = Keys_ro
open Lwt.Syntax
let ( let*? ) = Lwt_result.bind
let ( let+? ) x f = Lwt_result.map f x
@ -62,19 +63,36 @@ struct
|> Option.to_result ~none:(`Msg (Fmt.str "missing `%s` directory" name))
|> Lwt_result.lift
let assets ro =
let lwt_list_get_ok l =
let err = ref None in
let+ l = l 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*? 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
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
let*? _privacy_files =
privacy_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok
in
Lwt_result.return ()
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 =