diff --git a/src/headers.ml b/src/headers.ml index a068cf02..fa4bea84 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -46,24 +46,28 @@ module Etag : sig module to parse < "*" / #entity-tag >, used for If-Match and If-None-Match headers *) type t + type header_value - val parse : string -> t + val parse : string -> (header_value, string) result val of_crockford32 : string -> (t, string) result val to_field_value : t -> string + val evaluate : t -> header_value -> bool end = struct - type etag = { weak: bool; value: string } - type t = Any_etag | Etag_list of etag list + (* raw etag *) + type t = string - let pp_etag ppf { weak; value } = + (* 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 pp_etag_list = Fmt.list ~sep:(Fmt.any ", ") pp_etag + 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 pp ppf = function - | Any_etag -> Fmt.pf ppf "*" - | Etag_list etags -> Fmt.pf ppf "%a" pp_etag_list etags - - let to_field_value t = Fmt.str "%a" pp t let invalid_etag = Error "invalid etag field" let has_valid_charset s = @@ -74,13 +78,7 @@ end = struct String.for_all f s let of_crockford32 s = - (* always weak comparison for If-None-Match header *) - let weak = true in - match has_valid_charset s with - | false -> invalid_etag - | true -> - let v = Etag_list [ { weak; value= s } ] in - Ok v + match has_valid_charset s with false -> invalid_etag | true -> Ok s let trim_dquote s = let len = String.length s in @@ -89,12 +87,12 @@ end = struct else invalid_etag let parse s = - if String.trim s = "*" then Any_etag + if String.trim s = "*" then Ok Any_etag else String.split_on_char ',' s |> List.map String.trim |> List.filter (( <> ) "") - |> List.map (fun s -> + |> Syntax.list_map (fun s -> (* "W/" is the weak comparison indicator *) let weak, s = if String.starts_with ~prefix:"W/" s then @@ -104,6 +102,17 @@ end = struct Result.bind (trim_dquote s) (fun s -> if has_valid_charset s then Ok { weak; value= s } else invalid_etag)) - |> List.filter_map Result.to_option - |> fun l -> Etag_list l + |> 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 diff --git a/src/mte.ml b/src/mte.ml index 281ad06a..5f3268d7 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -14,24 +14,6 @@ along with this program. If not, see . *) module Static = struct - (* /terms + /privacy - - - try to find a response with an acceptable mime-type, - - then pick the version in the most preferred language of the user, - - and finally apply compression if that is allowed by the client - - set ETAG header - - TODO: - - subsequent requests of the client should provide the tag in an "If-None-Match" header - to detect if the terms of service have changed - - If it did not change, a "304 Not Modified" response will be returned - - The ETAG is encoded in Crockford base-32 - - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms - - When returning a full response (not a "304 Not Modified"), the server - should also include a "Avail-Languages" header which includes a - comma-separated list of the languages in which the terms of service are available in - *) - let select_file headers kind = let open Syntax in let* ext = @@ -45,25 +27,55 @@ module Static = struct let content = Assets.get_content ~lang ~ext kind in content - (* TODO add headers, handle errors etc - think on how to (not) mix error and vif monade well *) + (* /terms + /privacy + + - try to find a response with an acceptable mime-type, + - then pick the version in the most preferred language of the user, + - and finally apply compression if that is allowed by the client + - set ETAG header + - If it did not change, a "304 Not Modified" response will be returned + + TODO: + - The ETAG is encoded in Crockford base-32 + - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms + - When returning a full response (not a "304 Not Modified"), the server + should also include a "Avail-Languages" header which includes a + comma-separated list of the languages in which the terms of service are available in + *) let static kind req _server _env = - let open Vif.Response.Syntax in - let headers = Vif.Request.headers req in - (* TODO(etag) *) - let _if_none_match = Vif.Headers.get headers "if-none-match" in - let data = - match select_file headers kind with - | Error e -> Fmt.failwith "%s" e - | Ok content -> content + let get_ok = function + | Error e -> Fmt.failwith "TODO handle me, %s" e + | Ok v -> v in - let compression = Headers.select_encoding headers in - let* () = Vif.Response.with_string ?compression req data in - (* TODO(etag) *) - let* () = Vif.Response.add ~field:"etag" (Assets.etag kind) in - (* TODO content-type *) - let* () = Vif.Response.add ~field:"content-type" "html; charset=utf-8" in - Vif.Response.respond `OK + let etag = + (* TODO keep our static asset etag as Etag.t in Config? *) + Assets.etag kind |> Headers.Etag.of_crockford32 |> Result.get_ok + in + let headers = Vif.Request.headers req in + let has_matching_etag = + get_ok + @@ + match Vif.Headers.get headers "if-none-match" with + | None -> Ok false + | Some s -> + Headers.Etag.parse s |> Result.map (Headers.Etag.evaluate etag) + in + let open Vif.Response.Syntax in + match has_matching_etag with + | true -> + let* () = Vif.Response.empty in + Vif.Response.respond `Not_modified + | false -> + let data = select_file headers kind |> get_ok in + let compression = Headers.select_encoding headers in + let* () = Vif.Response.with_string ?compression req data in + let etag_field_value = Headers.Etag.to_field_value etag in + let* () = Vif.Response.add ~field:"etag" etag_field_value in + (* TODO content-type *) + let* () = + Vif.Response.add ~field:"content-type" "html; charset=utf-8" + in + Vif.Response.respond `OK let terms = static Assets.Terms let privacy = static Assets.Privacy