101 lines
3.4 KiB
OCaml
101 lines
3.4 KiB
OCaml
|
(* 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
|