69 lines
2 KiB
OCaml
69 lines
2 KiB
OCaml
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
|