(* 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 *) (* todo: maybe move this type to config.ml *) type t = Terms | Privacy let etag = function | Terms -> Config.terms_etag | Privacy -> Config.privacy_etag let legal_version = function | Terms -> Config.terms_legal_version | Privacy -> Config.privacy_legal_version let base_dir = function | Terms -> Config.terms_dir | Privacy -> Config.privacy_dir (* 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 t = let prefix = base_dir t in let path_l = path_l |> List.filter_map (Fpath.rem_prefix prefix) 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 () = 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 supported_mimetype_arr = Array.map Util.Mimetype.of_extension supported_ext_arr |> Array.map Option.get let is_supported_lang lang = Array.mem lang supported_lang_arr let is_supported_ext ext = Array.mem ext supported_ext_arr let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr (* todo - put content in a matrix instead? - better types to force valid params? *) (* ! lang and mime must be supported *) let get_content ~lang ~mime t = let etag = Headers_lib.Etag.to_raw_string (etag t) in let ext = match Util.Mimetype.to_extension mime with | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime) | Some ext -> ext in let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + ext) in match Assets_crunch.read path with | None -> Fmt.failwith "static file not found: `%s`" path | Some data -> data