src/headers_lib.ml

@@ -39,49 +39,45 @@ end = struct
     let v = { weak= true; value= t } in
     Fmt.str "%a" pp_header_etag_item v
 
-  let invalid_etag = Error "invalid etag field"
+  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 =
-    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 has_valid_charset s = String.for_all is_valid_char s
 
   let of_crockford32 s =
-    match has_valid_charset s with false -> invalid_etag | true -> Ok s
+    match has_valid_charset s with
+    | false -> Error "invalid etag"
+    | true -> Ok s
 
-  let trim_dquote 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 =
+    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"
+    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
 
-  (* TODO angstrom parser instead *)
-  let parse s =
-    if String.trim s = "*" then Ok Any_etag
-    else
-      String.split_on_char ',' s
-      |> List.map String.trim
-      |> List.filter (( <> ) "")
-      |> Syntax.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 (trim_dquote s) (fun s ->
-                 if has_valid_charset s then Ok { weak; value= s }
-                 else invalid_etag))
-      |> Result.map (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