mte/src/static.ml

(* TODO check for mathcing ETAG with a middleware instead? *)
(* /terms + /privacy
   - try to find a response with an acceptable mime-type
   - pick the version in the most preferred language of the user
   - apply compression if that is allowed by the client
   - set ETAG header
   - If it did not change, a "304 Not Modified" response will be returned
   - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms
   - When returning a full response (not a "304 Not Modified"),
     include a "Avail-Languages" header: a comma-separated list of the languages available *)

module Respond_with = struct
  open Vif.Response
  open Syntax

  open struct
    let error_detail ?hint _status =
      let open Api in
      let code = -1 in
      let err = ErrorDetail.make ?hint code in
      let s = encode_exn ErrorDetail.jsont err in
      s
  end

  let bad_request ?hint req =
    let body = error_detail ?hint `Bad_request in
    let* () = with_string ?compression:None req body in
    respond `Bad_request

  let not_modified () =
    let* () = empty in
    respond `Not_modified

  let unsupported_media_type req =
    let body =
      error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
    in
    let* () = with_string ?compression:None req body in
    let* () = add ~field:"accept" Headers.accept_header_value in
    respond `Unsupported_media_type
end

let aux kind req _server _env =
  let etag = Assets.etag kind in
  let headers = Vif.Request.headers req in
  let has_matching_etag =
    match Vif.Headers.get headers "if-none-match" with
    | None -> Ok false
    | Some s ->
        Headers_lib.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
  in
  match has_matching_etag with
  | Error e -> Respond_with.bad_request ~hint:e req
  | Ok true -> Respond_with.not_modified ()
  | Ok false -> (
      match Headers.select_mimetype headers with
      | None -> Respond_with.unsupported_media_type req
      | Some mime ->
          let lang = Headers.select_language headers in
          let compression = Headers.select_encoding headers in
          let data = Assets.get_content ~mime ~lang kind in
          (* -- *)
          let open Vif.Response in
          let open Syntax in
          let* () = with_string ?compression req data in
          let* () =
            let etag_field_value = Headers_lib.Etag.to_field_value etag in
            add ~field:"etag" etag_field_value
          in
          let* () =
            (* todo: is it "taler-privacy-version" for /policy ? *)
            add ~field:"taler-terms-version" Assets.terms_legal_version
          in
          let* () =
            add ~field:"avail-languages" Headers.avail_languages_header_value
          in
          let* () =
            let content_type = Fmt.str "%a" Assets.Mimetype.pp_mime mime in
            add ~field:"content-type" content_type
          in
          respond `OK)

let terms req _server _env = aux Assets.Terms req _server _env
let privacy req _server _env = aux Assets.Privacy req _server _env