(* doc: https://docs.taler.net/design-documents/003-tos-rendering.html - must support `text/plain` and `text/markdown` *) (* 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 (* TODO how to update ToS version? *) let terms_legal_version = "0" let privacy_legal_version = "0" (* TODO config *) type t = | Terms | Privacy (* TODO etag = filename *) let etag k = let etag = match k with Terms -> "0" | Privacy -> "0" in etag |> Headers_lib.Etag.of_crockford32 |> Result.get_ok let legal_version = function | Terms -> terms_legal_version | Privacy -> privacy_legal_version let base_dir = function Terms -> "terms" | Privacy -> "privacy" (* TODO clean up this horror *) 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 = Fpath.v (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 default_lang lang_l then Fmt.failwith "default language `%s` files not found" 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) 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 all_supported = 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 -> Fmt.failwith "extension `%s` unsupported" ext | None -> all_supported let default = default_mimetype let of_cohttp = function | Cohttp.Accept.MediaType (m, m_sub) -> List.find_opt (( = ) (m, m_sub)) all_supported | AnyMediaSubtype m -> List.find_opt (fun (m', _) -> String.equal m m') all_supported | AnyMedia -> Some default let to_extension_exn t = match List.assoc_opt t assoc with | None -> Fmt.failwith "Mimetype.to_extension failure: `%s/%s` unknown" (fst t) (snd t) | Some ext -> ext end module Language = struct type t = string let default = 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 etag = Headers_lib.Etag.to_raw_string (etag t) in let ext = Mimetype.to_extension_exn mime in let path = Fpath.to_string Fpath.((v (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