add Etag module (untested)

src/mte.ml

@@ -52,6 +52,80 @@ module Header_util = struct
     | `Identity :: _ -> None
     | `DEFLATE :: _ -> Some `DEFLATE
     | `Gzip :: _ -> Some `Gzip
+
+  module Etag : sig
+    (* TODO
+       - test
+       - don't ignore broken etag format *)
+    [@@@ocaml.warning "-32"]
+
+    (* https://httpwg.org/specs/rfc9110.html#field.etag
+       module to parse < "*" / #entity-tag >
+       for If-Match and If-None-Match header value *)
+    type etag = private { weak: bool; value: string }
+    type t = Any_etag | Etag_list of etag list
+
+    val parse : string -> t
+    val of_crockford32 : string -> (t, string) result
+    val to_field_value : t -> string
+  end = struct
+    type etag = { weak: bool; value: string }
+    type t = Any_etag | Etag_list of etag list
+
+    let invalid_etag = Error "invalid Etag field"
+
+    let is_valid_etag_string s =
+      let f c =
+        let n = Char.code c in
+        (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+      in
+      String.for_all f s
+
+    let pp_etag 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 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 of_crockford32 s =
+      (* always weak for If-None-Match *)
+      let weak = true in
+      match is_valid_etag_string s with
+      | false -> invalid_etag
+      | true ->
+          let v = Etag_list [ { weak; value= s } ] in
+          Ok v
+
+    let unquote s =
+      let len = String.length s in
+      if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then
+        Ok (String.sub s 1 (len - 2))
+      else invalid_etag
+
+    let parse s =
+      if String.trim s = "*" then Any_etag
+      else
+        String.split_on_char ',' s
+        |> List.map String.trim
+        |> List.filter (( <> ) "")
+        |> List.map (fun s ->
+               (* "W/" is the weak comparison indicator *)
+               let weak, s =
+                 if String.starts_with ~prefix:"W/" s then
+                   (true, String.sub s 2 (String.length s - 2))
+                 else (false, s)
+               in
+               Result.bind (unquote s) (fun s ->
+                   if is_valid_etag_string s then Ok { weak; value= s }
+                   else invalid_etag))
+        |> List.filter_map Result.to_option
+        |> fun l -> Etag_list l
+  end
 end
 
 module Static = struct
@@ -98,7 +172,7 @@ module Static = struct
     in
     let compression = Header_util.select_encoding headers in
     let* () = Vif.Response.with_string ?compression req data in
-    let* () = Vif.Response.add ~field:"ETAG" (Assets.etag kind) in
+    let* () = Vif.Response.add ~field:"etag" (Assets.etag kind) in
     (* TODO content-type *)
     let* () = Vif.Response.add ~field:"content-type" "html; charset=utf-8" in
     Vif.Response.respond `OK