etag: angstrom parser

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 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 parse =
-    let len = String.length s in
+    let open Angstrom in
-    if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then
+    let ws = skip_while (function ' ' -> true | _ -> false) in
-      Ok (String.sub s 1 (len - 2))
+    let quoted_string =
-    else invalid_etag
+      char '"' *> take_till (fun c -> c = '"') <* char '"' >>= fun s ->
-
+      if String.for_all is_valid_char s then return s
-  (* TODO angstrom parser instead *)
+      else fail "found illegal char"
-  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 ->
+    let item =
-                 if has_valid_charset s then Ok { weak; value= s }
+      ws
-                 else invalid_etag))
+      *> lift2
-      |> Result.map (fun l -> Etag_list l)
+           (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
 
-  (* 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

test/test.ml

@@ -37,3 +37,32 @@ let () =
   let r = of_string {|+EUR:4.99999999999999999999999|} in
   assert (Result.is_error r);
   ()
+
+let () =
+  let open Headers_lib.Etag in
+  let check input = assert (Result.is_ok (parse input)) in
+  let check_bad input = assert (Result.is_error (parse input)) in
+
+  check "*";
+  check "\"foo\"";
+  check "W/\"foo\"";
+  check "\"foo\", \"bar\"";
+  check " W/\"x\" , W/\"y\" , \"z\" ";
+  check "  \"one\" ,  \"two\"  ,  \"three\"  ";
+  check "W/\"a\"";
+  check "  W/\"a\" , \"b\"";
+
+  check_bad "";
+  check_bad "foo";
+  check_bad "W/foo";
+  check_bad "W/\"unterminated";
+  check_bad "\"foo\", W/";
+  check_bad "* , \"bar\"";
+  check_bad "\"a\" \"b\"";
+  check_bad "W/\"a\" W/\"b\"";
+  check_bad "\"fo\x7Fo\"";
+
+  (* TODO trailing comma are valid actually, I think *)
+  check_bad "\"foo\" ,";
+  check_bad ", \"foo\"";
+  ()