refacto
This commit is contained in:
parent
2596733033
commit
305818ae4a
20 changed files with 649 additions and 757 deletions
231
src/assets.ml
231
src/assets.ml
|
|
@ -1,6 +1,10 @@
|
|||
(* https://docs.taler.net/design-documents/003-tos-rendering.html
|
||||
must support `text/plain` and `text/markdown` *)
|
||||
|
||||
module Cfg = struct
|
||||
let config = "mte.conf"
|
||||
end
|
||||
|
||||
let failure fmt =
|
||||
Fmt.kstr
|
||||
(fun s ->
|
||||
|
|
@ -8,157 +12,78 @@ let failure fmt =
|
|||
exit 1)
|
||||
fmt
|
||||
|
||||
type t =
|
||||
| Terms
|
||||
| Privacy
|
||||
|
||||
module Cfg = struct
|
||||
(* hardcoded config just for static assets *)
|
||||
let default_lang = "en"
|
||||
let default_mimetype = ("text", "plain")
|
||||
let default_extension = ".txt"
|
||||
let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
|
||||
let base_dir = function Terms -> "terms" | Privacy -> "privacy"
|
||||
|
||||
(* TODO this should be in the config like terms_etag *)
|
||||
let terms_legal_version = "0"
|
||||
end
|
||||
|
||||
let etag k =
|
||||
match k with Terms -> Config.terms_etag | Privacy -> Config.privacy_etag
|
||||
|
||||
let supported_lang_arr, supported_ext_arr =
|
||||
let aux t =
|
||||
let prefix = Fpath.v (Cfg.base_dir t) in
|
||||
let path_l = List.map Fpath.v Assets_crunch.file_list in
|
||||
let path_l = List.filter_map (Fpath.rem_prefix prefix) path_l in
|
||||
let ext_l =
|
||||
path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
|
||||
in
|
||||
let lang_l =
|
||||
List.map
|
||||
(fun path ->
|
||||
match Fpath.segs path with
|
||||
| [] -> assert false
|
||||
| [ dir; _file ] -> dir
|
||||
| _l ->
|
||||
failure "invalid folder structure, file `%s` is misplaced"
|
||||
(Fpath.to_string Fpath.(prefix // path)))
|
||||
path_l
|
||||
in
|
||||
let lang_l = List.sort_uniq String.compare lang_l in
|
||||
let etag = etag t in
|
||||
List.iter
|
||||
(fun path ->
|
||||
let etag' = Fpath.to_string (Fpath.rem_ext (Fpath.base path)) in
|
||||
if not @@ String.equal etag etag' then
|
||||
failure "filename `%s` does not match configuration ETAG value `%s`"
|
||||
(Fpath.to_string Fpath.(prefix // path))
|
||||
etag)
|
||||
path_l;
|
||||
if List.is_empty lang_l then failure "no language supported";
|
||||
if List.is_empty ext_l then failure "no mimetype supported";
|
||||
if not @@ List.mem Cfg.default_lang lang_l then
|
||||
failure "default language `%s` files not found" Cfg.default_lang;
|
||||
if not @@ List.mem ".txt" ext_l then failure "plain text file not found";
|
||||
if not @@ List.mem ".md" ext_l then failure "markdown file not found";
|
||||
List.iter
|
||||
(fun dir ->
|
||||
if String.length dir <> 2 then
|
||||
failure "language directory with invalid name: `%s`" dir)
|
||||
lang_l;
|
||||
if List.length path_l <> List.length ext_l * List.length lang_l then
|
||||
failure
|
||||
"invalid folder structure, all supported language must provide the \
|
||||
same set of file mimetype"
|
||||
else (lang_l, ext_l)
|
||||
in
|
||||
let lang_l, ext_l = aux Terms in
|
||||
let lang_l', ext_l' = aux Privacy in
|
||||
match
|
||||
List.equal String.equal lang_l lang_l'
|
||||
&& List.equal String.equal ext_l ext_l'
|
||||
with
|
||||
| false ->
|
||||
failure
|
||||
"invalid folder structure, /terms and /privacy must support the same \
|
||||
set of languages and mimetypes"
|
||||
| true -> (Array.of_list lang_l, Array.of_list ext_l)
|
||||
|
||||
module Mimetype = struct
|
||||
type t = string * string
|
||||
|
||||
let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
|
||||
|
||||
let assoc =
|
||||
List.filter
|
||||
(fun (_mime, ext) -> Array.mem ext supported_ext_arr)
|
||||
[
|
||||
(("text", "plain"), ".txt");
|
||||
(("text", "markdown"), ".md");
|
||||
(("text", "html"), ".html");
|
||||
(("text", "html"), ".htm");
|
||||
(("application", "pdf"), ".pdf");
|
||||
(("image", "jpeg"), ".jpg");
|
||||
(("image", "jpeg"), ".jpeg");
|
||||
(("image", "png"), ".png");
|
||||
(("image", "gif"), ".gif");
|
||||
]
|
||||
|
||||
let default = Cfg.default_mimetype
|
||||
|
||||
let () =
|
||||
if not @@ List.mem (Cfg.default_mimetype, Cfg.default_extension) assoc then
|
||||
failure "default content type `%a` not supported" pp Cfg.default_mimetype
|
||||
|
||||
let arr =
|
||||
let all_supported, all_supported_ext = List.split assoc in
|
||||
match
|
||||
Array.find_opt
|
||||
(fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
|
||||
supported_ext_arr
|
||||
with
|
||||
| Some ext -> failure "extension `%s` unsupported" ext
|
||||
| None -> Array.of_list all_supported
|
||||
|
||||
let of_cohttp = function
|
||||
| Cohttp.Accept.MediaType (m, m_sub) ->
|
||||
Array.find_opt (( = ) (m, m_sub)) arr
|
||||
| AnyMediaSubtype m -> Array.find_opt (fun (m', _) -> String.equal m m') arr
|
||||
| AnyMedia -> Some default
|
||||
|
||||
let to_extension_exn t =
|
||||
match List.assoc_opt t assoc with
|
||||
| None -> Fmt.failwith "Mimetype.to_extension failure: `%a` unknown" pp t
|
||||
| Some ext -> ext
|
||||
end
|
||||
|
||||
module Language = struct
|
||||
type t = string
|
||||
|
||||
let arr = supported_lang_arr
|
||||
let default = Cfg.default_lang
|
||||
|
||||
let () =
|
||||
if not @@ Array.mem default arr then
|
||||
failure "default language `%s` not supported" Cfg.default_lang
|
||||
|
||||
let of_cohttp = function
|
||||
| Cohttp.Accept.AnyLanguage -> Some default
|
||||
| Language language_range -> (
|
||||
(* ignore language subtags (e.g. "en-US" -> "en") *)
|
||||
match language_range with
|
||||
| [] -> assert false
|
||||
| lang :: _ when Array.mem lang supported_lang_arr -> Some lang
|
||||
| _ -> None)
|
||||
end
|
||||
|
||||
(* ! lang and mime must be supported *)
|
||||
let get_content ~lang ~mime t =
|
||||
let ext = Mimetype.to_extension_exn mime in
|
||||
let path =
|
||||
Fpath.to_string Fpath.((v (Cfg.base_dir t) / lang / etag t) + ext)
|
||||
in
|
||||
match Assets_crunch.read path with
|
||||
| None -> Fmt.failwith "static file not found: `%s`" path
|
||||
let config =
|
||||
match Assets_crunch.read Cfg.config with
|
||||
| None -> failure "static configuration file `%s` not found" Cfg.config
|
||||
| Some data -> data
|
||||
|
||||
let mimetype_of_ext ext =
|
||||
List.assoc_opt ext
|
||||
[
|
||||
(".txt", ("text", "plain"));
|
||||
(".md", ("text", "markdown"));
|
||||
(".html", ("text", "html"));
|
||||
(".htm", ("text", "html"));
|
||||
(".pdf", ("application", "pdf"));
|
||||
(".jpg", ("image", "jpeg"));
|
||||
(".jpeg", ("image", "jpeg"));
|
||||
(".png", ("image", "png"));
|
||||
(".gif", ("image", "gif"));
|
||||
]
|
||||
|
||||
let load asset_prefix asset_etag =
|
||||
let asset_files =
|
||||
Assets_crunch.file_list
|
||||
|> List.map (String.split_on_char '/')
|
||||
|> List.filter (function hd :: _tl -> hd = asset_prefix | _ -> false)
|
||||
in
|
||||
let lang_l, ext_l =
|
||||
asset_files
|
||||
|> List.map (function
|
||||
| [ asset_prefix; dir; filename ] ->
|
||||
if String.length dir <> 2 then
|
||||
failure "invalid language directory name: `%s`" dir;
|
||||
let etag, ext =
|
||||
match String.split_on_char '.' filename with
|
||||
| [ etag; ext ] -> (etag, "." ^ ext)
|
||||
| _ -> failure "invalid filename: `%s`" filename
|
||||
in
|
||||
if not @@ String.equal asset_etag etag then
|
||||
failure
|
||||
"file `%s/%s/%s%s` does not match configuration ETAG value `%s`"
|
||||
asset_prefix dir etag ext asset_etag;
|
||||
(dir, ext)
|
||||
| _ -> failure "invalid directory contents")
|
||||
|> List.split
|
||||
in
|
||||
let lang_l = List.sort_uniq String.compare lang_l in
|
||||
let ext_l = List.sort_uniq String.compare ext_l in
|
||||
if List.is_empty lang_l then failure "no language supported";
|
||||
if List.is_empty ext_l then failure "no mimetype supported";
|
||||
if not @@ List.mem ".txt" ext_l then failure "plain text file not found";
|
||||
if not @@ List.mem ".md" ext_l then failure "markdown file not found";
|
||||
if List.length asset_files <> List.length ext_l * List.length lang_l then
|
||||
failure
|
||||
"invalid folder structure, all supported language must provide the same \
|
||||
set of file mimetype";
|
||||
let lang_arr = Array.of_list (List.sort compare lang_l) in
|
||||
let ext_arr = Array.of_list (List.sort compare ext_l) in
|
||||
let mime_arr =
|
||||
Array.map
|
||||
(fun ext ->
|
||||
match mimetype_of_ext ext with
|
||||
| None -> failure "unsupported extension: `%s`" ext
|
||||
| Some mime -> mime)
|
||||
ext_arr
|
||||
in
|
||||
let content_matrix =
|
||||
Array.init (Array.length lang_arr) (fun i ->
|
||||
Array.init (Array.length ext_arr) (fun j ->
|
||||
let lang = lang_arr.(i) in
|
||||
let ext = ext_arr.(j) in
|
||||
let file = Fmt.str "%s/%s/%s%s" asset_prefix lang asset_etag ext in
|
||||
match Assets_crunch.read file with
|
||||
| None -> failure "static file not found: `%s`" file
|
||||
| Some content_matrix -> content_matrix))
|
||||
in
|
||||
(lang_arr, mime_arr, content_matrix)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue