better if-not-match

src/headers_lib.ml

@@ -1,83 +1,69 @@
-(* library for headers fields value *)
-
-(* TODO clean up *)
-module Etag : sig
+module Etag = struct
   (* https://httpwg.org/specs/rfc9110.html#field.etag *)
 
-  type t
-  type header_value
-
-  val parse : string -> (header_value, string) result
-  val of_crockford32 : string -> (t, string) result
-  val to_raw_string : t -> string
-  val to_field_value : t -> string
-  val evaluate : t -> header_value -> bool
-end = struct
-  (* raw etag *)
-  type t = string
-
-  (* type for the value of header field *)
-  type header_etag_item = {
+  type t = {
     weak: bool;
     value: string;
   }
 
-  type header_value =
-    | Any_etag
-    | Etag_list of header_etag_item list
+  let pp ppf { weak; value } =
+    match weak with
+    | false -> Fmt.pf ppf {|"%s"|} value
+    | true -> Fmt.pf ppf {|W/"%s"|} value
 
-  let pp_header_etag_item ppf { weak; value } =
-    if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
+  let to_field_string t = Fmt.str "%a" pp t
 
-  let to_raw_string t = t
-
-  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 is_valid_char c =
-    let n = Char.code c in
-    (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
-
-  let has_valid_charset s = String.for_all is_valid_char s
-
-  let of_crockford32 s =
-    match has_valid_charset s with
-    | false -> Error "invalid etag"
-    | true -> Ok s
-
-  let parse =
+  let angstrom =
     let open Angstrom in
-    let ws = skip_while (function ' ' -> true | _ -> false) in
-    let quoted_string =
-      char '"' *> take_till (fun c -> c = '"') <* char '"' >>= fun s ->
-      if String.for_all is_valid_char s then return s
-      else fail "found illegal char"
+    let is_valid_char c =
+      let n = Char.code c in
+      (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
     in
-    let item =
-      ws
-      *> lift2
-           (fun weak value -> { weak; value })
-           (option false (string "W/" *> return true))
-           quoted_string
-      <* ws
-    in
-    let comma = ws *> char ',' *> ws in
-    let list_of_items = sep_by1 comma item in
-    let parse_header_value =
-      char '*' *> return Any_etag
-      <|> (list_of_items >>| fun items -> Etag_list items)
-      <* end_of_input
-    in
-    fun s ->
-      match parse_string ~consume:Consume.All parse_header_value s with
-      | Error e -> Fmt.error "invalid etag: %s" e
-      | Ok v -> Ok v
+    let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
+    lift2
+      (fun weak value -> { weak; value })
+      (option false (string "W/" *> return true))
+      quoted_string
 
-  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
+  let parse s =
+    match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+    | Error _e -> Fmt.error "invalid etag: `%s`" s
+    | Ok v -> Ok v
+end
+
+module If_none_match = struct
+  type t =
+    | Any
+    | List of Etag.t list
+
+  let pp ppf = function
+    | Any -> Fmt.pf ppf {|*|}
+    | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
+
+  let angstrom =
+    let open Angstrom in
+    let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
+    let comma = ows *> char ',' *> ows in
+    (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
+    let etag_opt = Etag.angstrom >>| Option.some <|> return None in
+    let etags =
+      etag_opt >>= fun hd ->
+      many (comma *> etag_opt) >>= fun tl ->
+      let l = List.filter_map Fun.id (hd :: tl) in
+      match l with [] -> fail "empty etag list" | l -> return (List l)
+    in
+    let any = char '*' *> return Any in
+    any <|> etags
+
+  let parse s =
+    match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+    | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
+    | Ok v -> Ok v
+
+  let evaluate etag t =
+    match t with
+    | Any -> false
+    | List l ->
+        not
+        @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
 end