handle etag header

src/headers.ml

@@ -46,24 +46,28 @@ module Etag : sig
        module to parse < "*" / #entity-tag >,
        used for If-Match and If-None-Match headers *)
   type t
+  type header_value
 
-  val parse : string -> t
+  val parse : string -> (header_value, string) result
   val of_crockford32 : string -> (t, string) result
   val to_field_value : t -> string
+  val evaluate : t -> header_value -> bool
 end = struct
-  type etag = { weak: bool; value: string }
+  (* raw etag *)
-  type t = Any_etag | Etag_list of etag list
+  type t = string
 
-  let pp_etag ppf { weak; value } =
+  (* type for the value of header field *)
+  type header_etag_item = { weak: bool; value: string }
+  type header_value = Any_etag | Etag_list of header_etag_item list
+
+  let pp_header_etag_item ppf { weak; value } =
     if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
 
-  let pp_etag_list = Fmt.list ~sep:(Fmt.any ", ") pp_etag
+  let to_field_value t =
+    (* always weak comparison for If-None-Match header *)
+    let v = { weak= true; value= t } in
+    Fmt.str "%a" pp_header_etag_item v
 
-  let pp ppf = function
-    | Any_etag -> Fmt.pf ppf "*"
-    | Etag_list etags -> Fmt.pf ppf "%a" pp_etag_list etags
-
-  let to_field_value t = Fmt.str "%a" pp t
   let invalid_etag = Error "invalid etag field"
 
   let has_valid_charset s =
@@ -74,13 +78,7 @@ end = struct
     String.for_all f s
 
   let of_crockford32 s =
-    (* always weak comparison for If-None-Match header *)
+    match has_valid_charset s with false -> invalid_etag | true -> Ok s
-    let weak = true in
-    match has_valid_charset s with
-    | false -> invalid_etag
-    | true ->
-        let v = Etag_list [ { weak; value= s } ] in
-        Ok v
 
   let trim_dquote s =
     let len = String.length s in
@@ -89,12 +87,12 @@ end = struct
     else invalid_etag
 
   let parse s =
-    if String.trim s = "*" then Any_etag
+    if String.trim s = "*" then Ok Any_etag
     else
       String.split_on_char ',' s
       |> List.map String.trim
       |> List.filter (( <> ) "")
-      |> List.map (fun s ->
+      |> Syntax.list_map (fun s ->
              (* "W/" is the weak comparison indicator *)
              let weak, s =
                if String.starts_with ~prefix:"W/" s then
@@ -104,6 +102,17 @@ end = struct
              Result.bind (trim_dquote s) (fun s ->
                  if has_valid_charset s then Ok { weak; value= s }
                  else invalid_etag))
-      |> List.filter_map Result.to_option
+      |> Result.map (fun l -> Etag_list l)
-      |> fun l -> Etag_list l
+
+  (* To evaluate a received If-None-Match header field:
+     - If the field value is "*", the condition is false
+       if the origin server has a current representation for the target resource.
+     - If the field value is a list of entity tags, the condition is false
+       if one of the listed tags matches the entity tag of the selected representation.
+     - Otherwise, the condition is true. *)
+  let evaluate t header_value =
+    match header_value with
+    | Any_etag -> false
+    | Etag_list l ->
+        not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
 end

src/mte.ml

@@ -14,24 +14,6 @@
     along with this program.  If not, see <https://www.gnu.org/licenses/>. *)
 
 module Static = struct
-  (* /terms + /privacy
-
-     - try to find a response with an acceptable mime-type,
-     - then pick the version in the most preferred language of the user,
-     - and finally apply compression if that is allowed by the client
-     - set ETAG header
-
-     TODO:
-       - subsequent requests of the client should provide the tag in an "If-None-Match" header
-         to detect if the terms of service have changed
-       - If it did not change, a "304 Not Modified" response will be returned
-       - The ETAG is encoded in Crockford base-32
-       - 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"), the server
-         should also include a "Avail-Languages" header which includes a
-         comma-separated list of the languages in which the terms of service are available in
-  *)
-
   let select_file headers kind =
     let open Syntax in
     let* ext =
@@ -45,24 +27,54 @@ module Static = struct
     let content = Assets.get_content ~lang ~ext kind in
     content
 
-  (* TODO add headers, handle errors etc
+  (* /terms + /privacy
-     think on how to (not) mix error and vif monade well *)
+
+     - try to find a response with an acceptable mime-type,
+     - then pick the version in the most preferred language of the user,
+     - and finally 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
+
+     TODO:
+       - The ETAG is encoded in Crockford base-32
+       - 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"), the server
+         should also include a "Avail-Languages" header which includes a
+         comma-separated list of the languages in which the terms of service are available in
+  *)
   let static kind req _server _env =
-    let open Vif.Response.Syntax in
+    let get_ok = function
-    let headers = Vif.Request.headers req in
+      | Error e -> Fmt.failwith "TODO handle me, %s" e
-    (* TODO(etag) *)
+      | Ok v -> v
-    let _if_none_match = Vif.Headers.get headers "if-none-match" in
-    let data =
-      match select_file headers kind with
-      | Error e -> Fmt.failwith "%s" e
-      | Ok content -> content
     in
+    let etag =
+      (* TODO keep our static asset etag as Etag.t in Config? *)
+      Assets.etag kind |> Headers.Etag.of_crockford32 |> Result.get_ok
+    in
+    let headers = Vif.Request.headers req in
+    let has_matching_etag =
+      get_ok
+      @@
+      match Vif.Headers.get headers "if-none-match" with
+      | None -> Ok false
+      | Some s ->
+          Headers.Etag.parse s |> Result.map (Headers.Etag.evaluate etag)
+    in
+    let open Vif.Response.Syntax in
+    match has_matching_etag with
+    | true ->
+        let* () = Vif.Response.empty in
+        Vif.Response.respond `Not_modified
+    | false ->
+        let data = select_file headers kind |> get_ok in
         let compression = Headers.select_encoding headers in
         let* () = Vif.Response.with_string ?compression req data in
-    (* TODO(etag) *)
+        let etag_field_value = Headers.Etag.to_field_value etag in
-    let* () = Vif.Response.add ~field:"etag" (Assets.etag kind) in
+        let* () = Vif.Response.add ~field:"etag" etag_field_value in
         (* TODO content-type *)
-    let* () = Vif.Response.add ~field:"content-type" "html; charset=utf-8" in
+        let* () =
+          Vif.Response.add ~field:"content-type" "html; charset=utf-8"
+        in
         Vif.Response.respond `OK
 
   let terms = static Assets.Terms