better if-not-match

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

@@ -0,0 +1,69 @@
+module Etag = struct
+  (* https://httpwg.org/specs/rfc9110.html#field.etag *)
+
+  type t = {
+    weak: bool;
+    value: string;
+  }
+
+  let pp ppf { weak; value } =
+    match weak with
+    | false -> Fmt.pf ppf {|"%s"|} value
+    | true -> Fmt.pf ppf {|W/"%s"|} value
+
+  let to_field_string t = Fmt.str "%a" pp t
+
+  let angstrom =
+    let open Angstrom in
+    let is_valid_char c =
+      let n = Char.code c in
+      (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+    in
+    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 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