swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-03 08:46:29 +01:00
parent 9440812f12
commit 301561614d
1 changed files with 13 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

37
unikernel/unikernel.ml
View file

@ -44,28 +44,17 @@ struct
module Assets = struct module Assets = struct
module Assets_ro = Keys_ro module Assets_ro = Keys_ro
let ( let*$ ) = Lwt_result.bind 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 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 get_subdirs ro k =
let*$ keys = Assets_ro.list ro k |> map_err_to_string in let+? keys = Assets_ro.list ro k |> map_err_to_string in
List.filter (fun (_, t) -> t = `Dictionary) keys List.filter (fun (_, t) -> t = `Dictionary) keys |> List.map fst
|> List.map fst
|> Lwt_result.return
let get_values ro k = let get_values ro k =
let*$ keys = Assets_ro.list ro k |> map_err_to_string in let+? keys = Assets_ro.list ro k |> map_err_to_string in
List.filter (fun (_, t) -> t = `Value) keys List.filter (fun (_, t) -> t = `Value) keys |> List.map fst
|> List.map fst
|> Lwt_result.return
let find keys name = let find keys name =
keys keys
@ -74,15 +63,15 @@ struct
|> Lwt_result.lift |> Lwt_result.lift
let assets ro = let assets ro =
let*$ base_dir = get_subdirs ro Mirage_kv.Key.empty in let*? base_dir = get_subdirs ro Mirage_kv.Key.empty in
let*$ terms_dir = find base_dir "terms" in let*? terms_dir = find base_dir "terms" in
let*$ privacy_dir = find base_dir "privacy" in let*? privacy_dir = find base_dir "privacy" in
let*$ terms_subdirs = get_subdirs ro terms_dir in let*? terms_subdirs = get_subdirs ro terms_dir in
let*$ privacy_subdirs = get_subdirs ro privacy_dir in let*? privacy_subdirs = get_subdirs ro privacy_dir in
let*$ _terms_files = let*? _terms_files =
terms_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok terms_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok
in in
let*$ _privacy_files = let*? _privacy_files =
privacy_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok privacy_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok
in in
Lwt_result.return () Lwt_result.return ()