add assets.ml

src/assets.ml

@@ -0,0 +1,100 @@
+(* module to handle assets.
+   for now, assets are defined to all be in `src/assets/` folder.
+   crunched into the [Assets_crunch] module.
+
+   to keep it simple, we require that /terms and /privacy support the same
+   set of languages X mimetypes *)
+
+(* docs:
+     https://docs.taler.net/manpages/taler-exchange.conf.5.html
+     https://docs.taler.net/design-documents/003-tos-rendering.html *)
+
+type kind = Terms | Privacy
+
+(* TODO
+   better use of Fmt to have error prefix or smthing
+   use Logs *)
+(* does some checks on assets/ folder content and infer the set of supported languages and mimetype *)
+let supported_lang_arr, supported_ext_arr =
+  let open Syntax in
+  let path_l =
+    Assets_crunch.file_list |> list_map Fpath.of_string |> function
+    | Error (`Msg e) -> Fmt.failwith "%s" e
+    | Ok x -> x
+  in
+  let aux kind =
+    let base_dir =
+      match kind with
+      | Terms -> Config.terms_dir
+      | Privacy -> Config.privacy_dir
+    in
+    let path_l = path_l |> List.filter_map (Fpath.rem_prefix base_dir) in
+    let ext_l =
+      path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
+    in
+    let lang_l =
+      path_l
+      |> List.map (fun path ->
+             match Fpath.segs path with
+             | [] -> assert false
+             | [ dir; _file ] -> dir
+             | _l ->
+                 Fmt.failwith "invalid folder structure, file `%s` is misplaced"
+                   (Fpath.to_string path))
+      |> List.sort_uniq String.compare
+    in
+    let () =
+      if List.is_empty lang_l then Fmt.failwith "no language supported";
+      if List.is_empty ext_l then Fmt.failwith "no mimetype supported";
+      if not @@ List.mem Config.default_lang lang_l then
+        Fmt.failwith "default language `%s` files not found" Config.default_lang;
+      if not @@ List.mem ".txt" ext_l then
+        Fmt.failwith "plain text file not found";
+      if not @@ List.mem ".md" ext_l then Fmt.failwith "markdown file not found";
+      List.iter
+        (fun dir ->
+          if String.length dir <> 2 then
+            Fmt.failwith "language directory with invalid name: `%s`" dir)
+        lang_l;
+      if List.length path_l <> List.length ext_l * List.length lang_l then
+        Fmt.failwith
+          "invalid folder structure, all supported language must provide the \
+           same set of file mimetype"
+    in
+    (lang_l, ext_l)
+  in
+  let lang_l, ext_l = aux Terms in
+  let lang_l', ext_l' = aux Privacy in
+  let () =
+    List.iter
+      (fun path ->
+        if not @@ Util.is_valid_filename path then
+          Fmt.failwith "file `%s` has an unsupported extension"
+            (Fpath.to_string path))
+      path_l;
+    if
+      not
+      @@ (List.equal String.equal lang_l lang_l'
+         && List.equal String.equal ext_l ext_l')
+    then
+      Fmt.failwith
+        "invalid folder structure, /terms and /privacy must support the same \
+         set of languages and mimetypes";
+    ()
+  in
+  (Array.of_list lang_l, Array.of_list ext_l)
+
+let is_supported_lang lang = Array.mem lang supported_lang_arr
+let is_supported_ext ext = Array.mem ext supported_ext_arr
+
+let get_content ~lang ~ext kind =
+  let path =
+    let open Config in
+    match kind with
+    | Terms -> Fpath.((terms_dir / lang / terms_etag) + ext)
+    | Privacy -> Fpath.((privacy_dir / lang / privacy_etag) + ext)
+  in
+  let path_str = Fpath.to_string path in
+  match Assets_crunch.read path_str with
+  | None -> Fmt.error "static file not found: `%s`" path_str
+  | Some data -> Ok data