85 lines
2.8 KiB
OCaml
85 lines
2.8 KiB
OCaml
|
(* independent module 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 < "*" / #entity-tag >,
|
||
|
|
used for 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 invalid_etag = Error "invalid etag field"
|
||
|
|
|
||
|
|
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 of_crockford32 s =
|
||
|
|
match has_valid_charset s with false -> invalid_etag | true -> Ok s
|
||
|
|
|
||
|
|
let trim_dquote s =
|
||
|
|
let len = String.length s in
|
||
|
|
if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then
|
||
|
|
Ok (String.sub s 1 (len - 2))
|
||
|
|
else invalid_etag
|
||
|
|
|
||
|
|
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 ->
|
||
|
|
if has_valid_charset s then Ok { weak; value= s }
|
||
|
|
else invalid_etag))
|
||
|
|
|> Result.map (fun l -> Etag_list l)
|
||
|
|
|
||
|
|
(* 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
|
||
|
|
| Etag_list l ->
|
||
|
|
not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
|
||
|
|
end
|