mte/src/assets.ml

(* 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 ->
      Fmt.epr "Assets failure: %s.@." s;
      exit 1)
    fmt

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)