better if-not-match

.jjconflict-side-1/src/static.ml

@@ -0,0 +1,79 @@
+(* /terms + /privacy *)
+
+(* TODO response *)
+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
+      Logs.err (fun m -> m "ErrorDetail: `%s`" s);
+      s
+  end
+
+  let bad_request ?hint req =
+    let body = error_detail ?hint `Bad_request in
+    let* () = add ~field:"content-type" "application/json" in
+    let* () = with_string ?compression:None req body in
+    respond `Bad_request
+
+  let not_modified () =
+    let* () = empty in
+    respond `Not_modified
+end
+
+let aux asset req _server _env =
+  let etag = Assets.etag asset 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.If_none_match.parse s
+        |> Result.map (Headers_lib.If_none_match.evaluate etag)
+  in
+  match has_matching_etag with
+  | Error e ->
+      Logs.err (fun m -> m "bad request");
+      Respond_with.bad_request ~hint:e req
+  | Ok true ->
+      Logs.err (fun m -> m "not modified");
+      Respond_with.not_modified ()
+  | Ok false ->
+      let mime = Headers.select_mimetype headers in
+      let lang = Headers.select_language headers in
+      let compression = Headers.select_encoding headers in
+      let data = Assets.get_content ~mime ~lang asset 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_string etag in
+        add ~field:"etag" etag_field_value
+      in
+      let* () =
+        add ~field:"taler-terms-version"
+          Assets.Assets_config.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 in
+        add ~field:"content-type" content_type
+      in
+      let* () = add ~field:"content-language" lang in
+      respond `OK
+
+let terms req _server _env =
+  Logs.info (fun m -> m "GET /terms");
+  aux Assets.Terms req _server _env
+
+let privacy req _server _env =
+  Logs.info (fun m -> m "GET /privacy");
+  aux Assets.Privacy req _server _env