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
+    let*$ keys =
       Lwt.Infix.(
         Key.list key_ro Mirage_kv.Key.empty
         >|= R.reword_error (R.msgf "%a" Key.pp_error))
-    >>= fun keys ->
+    in
     let keys, _ = List.partition (fun (_, t) -> t = `Value) keys in
+    let*$ certificates =
       Lwt.Infix.(
         Certificate.list certificate_ro Mirage_kv.Key.empty
         >|= R.reword_error (R.msgf "%a" Certificate.pp_error))
-    >>= fun certificates ->
+    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))