unikernel/unikernel.ml

@@ -123,26 +123,49 @@ struct
               (Fmt.list Fmt.string) l
       in
       let* ext_l =
-        let ll =
+        let* hd, tl =
           l
           |> List.map (fun (_, _, v) -> v)
           |> List.map (List.sort String.compare)
+          |> function
+          | [] ->
+              Fmt.error_msg "directory `%s` is empty"
+                (Mirage_kv.Key.to_string dir)
+          | hd :: tl -> Ok (hd, tl)
         in
-        match List.sort_uniq Stdlib.compare ll with
+        match List.for_all (( = ) hd) tl with
-        | [ l ] -> Ok l
+        | false ->
-        | [] -> assert false
-        | _ll ->
             Fmt.error_msg
               "directory `%s` does not has the same set of file extensions for \
                each language"
               (Mirage_kv.Key.to_string dir)
+        | true -> Ok hd
       in
       Ok (etag, lang_l, ext_l)
 
     let assets ro =
-      let*? terms_assoc = get ro "terms" in
+      let*? terms_etag, terms_lang_l, terms_ext_l = get ro "terms" in
-      let*? privacy_assoc = get ro "privacy" in
+      let*? privacy_etag, privacy_lang_l, privacy_ext_l = get ro "privacy" in
-      Lwt_result.return (terms_assoc, privacy_assoc)
+      Lwt.return
+      @@
+      let open Result.Syntax in
+      let* lang_l =
+        match terms_lang_l = privacy_lang_l with
+        | false ->
+            Fmt.error_msg
+              "terms and privacy directories does not support the same set of \
+               languages"
+        | true -> Ok terms_lang_l
+      in
+      let ext_l =
+        match terms_ext_l = privacy_ext_l with
+        | false ->
+            Fmt.error_msg
+              "terms and privacy directories does not support the same set of \
+               mimetype"
+        | true -> Ok terms_ext_l
+      in
+      Ok (terms_etag, privacy_etag, lang_l, ext_l)
   end
 
   let tls certificate_ro key_ro =
@@ -255,14 +278,7 @@ struct
     let* assets_res = Assets.assets assets_ro in
     match assets_res with
     | Error (`Msg m) -> Fmt.failwith "Assets configuration error: %s." m
-    | Ok (_terms, _privacy) -> (
+    | Ok (_terms_etag, _privacy_etag, _lang_l, _ext_l) -> (
-        (*
-        let etag, lang_l, ext_l = terms in
-        Fmt.pr "ETAG: %s@\nlanguages: %a@\nextensions: %a@." etag
-          (Fmt.list ~sep:(Fmt.any ", ") Fmt.string)
-          lang_l
-          (Fmt.list ~sep:(Fmt.any ", ") Fmt.string)
-          ext_l; *)
         let* tls_res = tls certificate_ro key_ro in
         match use_tls () with
         | false -> run ~ctx ~authenticator http_server