lib/headers_lib.ml

@@ -0,0 +1,86 @@
+(* independent library for headers fields value *)
+
+(* TODO - test - can still bypass this module and directly set Etag header, but
+   its fine *)
+module Etag : sig
+  (* module to parse etags header fields used by If-Match and If-None-Match
+     headers
+
+     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 = {
+    weak: bool;
+    value: string;
+  }
+
+  type header_value =
+    | Any_etag
+    | Etag_list of header_etag_item list
+
+  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_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 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
+
+  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
+end