diff --git a/unikernel/unikernel.ml b/unikernel/unikernel.ml index 3240533e..0881b0c7 100644 --- a/unikernel/unikernel.ml +++ b/unikernel/unikernel.ml @@ -28,6 +28,9 @@ let alpn = let ( <.> ) f g x = f (g x) let always x _ = x +let ( let* ) = Result.bind +let ( let$ ) = Lwt.bind +let ( let*$ ) = Lwt_result.bind module Make (Certificate : Mirage_kv.RO) @@ -36,25 +39,43 @@ module Make (Connect : Connect.S) (HTTP_server : Paf_mirage.S) = struct + let rm_gitkeep l = + List.filter (fun (name, _) -> ".gitkeep" <> Mirage_kv.Key.basename name) l + let tls key_ro certificate_ro = let open Lwt_result.Infix in - Lwt.Infix.( - Key.list key_ro Mirage_kv.Key.empty - >|= R.reword_error (R.msgf "%a" Key.pp_error)) - >>= fun keys -> + let*$ keys = + Lwt.Infix.( + Key.list key_ro Mirage_kv.Key.empty + >|= R.reword_error (R.msgf "%a" Key.pp_error)) + in let keys, _ = List.partition (fun (_, t) -> t = `Value) keys in - Lwt.Infix.( - Certificate.list certificate_ro Mirage_kv.Key.empty - >|= R.reword_error (R.msgf "%a" Certificate.pp_error)) - >>= fun certificates -> + let*$ certificates = + Lwt.Infix.( + Certificate.list certificate_ro Mirage_kv.Key.empty + >|= R.reword_error (R.msgf "%a" Certificate.pp_error)) + in let certificates, _ = List.partition (fun (_, t) -> t = `Value) certificates in + let certificates = rm_gitkeep certificates in + let certificates = + certificates + |> List.map (fun (name, _) -> + let*$ data = + Lwt.Infix.( + Certificate.get certificate_ro name + >|= R.reword_error (R.msgf "%a" Certificate.pp_error)) + in + let*$ certificates = + Lwt.return @@ X509.Certificate.decode_pem_multiple data + in + Lwt_result.return (name, certificates)) + in let fold acc (name, _) = match Mirage_kv.Key.basename name with | ".gitkeep" -> Lwt.return acc | _ -> - let open Lwt_result.Infix in Lwt.Infix.( Certificate.get certificate_ro name >|= R.reword_error (R.msgf "%a" Certificate.pp_error))