(* 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