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

70 lines
2 KiB
OCaml
Raw Normal View History

2026-02-12 11:25:57 +01:00
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