From 156894023e1bd20d65e9a8c5e6ee58e472e2fe96 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 4 Sep 2024 12:49:54 +0100 Subject: [PATCH] feature: remove [scheme] from requests (#1086) This makes it so that [Request.make ~uri |> Request.uri] will no longer return the same URI as [uri]. Also, this property was never preserved with respect to other URI fields. Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 ++ cohttp/src/request.ml | 91 ++++++++++++++++--------------------- cohttp/src/s.ml | 2 - cohttp/test/test_request.ml | 12 ++++- http/src/http.ml | 17 +++---- http/src/http.mli | 14 ++---- http/test/test_parser.ml | 2 +- 7 files changed, 62 insertions(+), 79 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7ca878c41..4cc0a0ef1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,8 @@ ## Unreleased +- http, cohttp: remove the scheme field from requests. This means that + [Request.uri] no longer returns the same URI as was to create the request + with [Request.make] (@rgrinberg 1086) - cohttp-eio: Remove unused `Client_intf` module (talex5 #1081) - cohttp-eio: Make server response type abstract and allow streaming in cohttp-eio (talex5 #1024) - cohttp-{lwt,eio}: server: add connection header to response if not present (ushitora-anqou #1025) diff --git a/cohttp/src/request.ml b/cohttp/src/request.ml index 6a6e63cfa..05ea64541 100644 --- a/cohttp/src/request.ml +++ b/cohttp/src/request.ml @@ -19,29 +19,24 @@ open Sexplib0.Sexp_conv type t = Http.Request.t = { headers : Header.t; meth : Code.meth; - scheme : string option; resource : string; version : Code.version; } [@@deriving sexp] -let compare { headers; meth; scheme; resource; version } y = +let compare { headers; meth; resource; version } y = match Header.compare headers y.headers with | 0 -> ( match Code.compare_method meth y.meth with | 0 -> ( - match Option.compare String.compare scheme y.scheme with - | 0 -> ( - match String.compare resource y.resource with - | 0 -> Code.compare_version version y.version - | i -> i) + match String.compare resource y.resource with + | 0 -> Code.compare_version version y.version | i -> i) | i -> i) | i -> i let headers t = t.headers let meth t = t.meth -let scheme t = t.scheme let resource t = t.resource let version t = t.version let encoding t = Header.get_transfer_encoding t.headers @@ -71,14 +66,13 @@ let make ?(meth = `GET) ?(version = `HTTP_1_1) ?encoding Header.add_authorization headers auth | _, _, _ -> headers in - let scheme = Uri.scheme uri in let resource = Uri.path_and_query uri in let headers = match encoding with | None -> headers | Some encoding -> Header.add_transfer_encoding headers encoding in - { headers; meth; scheme; resource; version } + { headers; meth; resource; version } let is_keep_alive t = Http.Request.is_keep_alive t @@ -110,49 +104,42 @@ let is_valid_uri path meth = | Some _ -> true | None -> not (String.length path > 0 && path.[0] <> '/') -let uri { scheme; resource; headers; meth; _ } = - let uri = - match resource with - | "*" -> ( - match Header.get headers "host" with - | None -> Uri.of_string "" - | Some host -> - let host_uri = Uri.of_string ("//" ^ host) in - Uri.(make ?host:(host host_uri) ?port:(port host_uri) ())) - | authority when meth = `CONNECT -> Uri.of_string ("//" ^ authority) - | path -> ( - let uri = Uri.of_string path in - match Uri.scheme uri with - | Some _ -> ( - Uri.( - (* we have an absoluteURI *) - match path uri with "" -> with_path uri "/" | _ -> uri)) - | None -> - let empty = Uri.of_string "" in - let empty_base = Uri.of_string "///" in - let pqs = - match Stringext.split ~max:2 path ~on:'?' with - | [] -> empty_base - | [ path ] -> +let uri { resource; headers; meth; _ } = + match resource with + | "*" -> ( + match Header.get headers "host" with + | None -> Uri.of_string "" + | Some host -> + let host_uri = Uri.of_string ("//" ^ host) in + Uri.(make ?host:(host host_uri) ?port:(port host_uri) ())) + | authority when meth = `CONNECT -> Uri.of_string ("//" ^ authority) + | path -> ( + let uri = Uri.of_string path in + match Uri.scheme uri with + | Some _ -> ( + Uri.( + (* we have an absoluteURI *) + match path uri with "" -> with_path uri "/" | _ -> uri)) + | None -> ( + let empty = Uri.of_string "" in + let empty_base = Uri.of_string "///" in + let pqs = + match Stringext.split ~max:2 path ~on:'?' with + | [] -> empty_base + | [ path ] -> + Uri.resolve "http" empty_base (Uri.with_path empty path) + | path :: qs :: _ -> + let path_base = Uri.resolve "http" empty_base (Uri.with_path empty path) - | path :: qs :: _ -> - let path_base = - Uri.resolve "http" empty_base (Uri.with_path empty path) - in - Uri.with_query path_base (Uri.query_of_encoded qs) - in - let uri = - match Header.get headers "host" with - | None -> Uri.(with_scheme (with_host pqs None) None) - | Some host -> - let host_uri = Uri.of_string ("//" ^ host) in - let uri = Uri.with_host pqs (Uri.host host_uri) in - Uri.with_port uri (Uri.port host_uri) - in - uri) - in - (* Only set the scheme if it's not already part of the URI *) - match Uri.scheme uri with Some _ -> uri | None -> Uri.with_scheme uri scheme + in + Uri.with_query path_base (Uri.query_of_encoded qs) + in + match Header.get headers "host" with + | None -> Uri.(with_scheme (with_host pqs None) None) + | Some host -> + let host_uri = Uri.of_string ("//" ^ host) in + let uri = Uri.with_host pqs (Uri.host host_uri) in + Uri.with_port uri (Uri.port host_uri))) type tt = t diff --git a/cohttp/src/s.ml b/cohttp/src/s.ml index 67004c49e..915433ff9 100644 --- a/cohttp/src/s.ml +++ b/cohttp/src/s.ml @@ -85,7 +85,6 @@ module type Request = sig type t = { headers : Header.t; (** HTTP request headers *) meth : Code.meth; (** HTTP request method *) - scheme : string option; (** URI scheme (http or https) *) resource : string; (** Request path and query *) version : Code.version; (** HTTP version, usually 1.1 *) } @@ -93,7 +92,6 @@ module type Request = sig val headers : t -> Header.t val meth : t -> Code.meth - val scheme : t -> string option val resource : t -> string val version : t -> Code.version val encoding : t -> Transfer.encoding diff --git a/cohttp/test/test_request.ml b/cohttp/test/test_request.ml index 8fa4d7026..d3a2cfb7c 100644 --- a/cohttp/test/test_request.ml +++ b/cohttp/test/test_request.ml @@ -249,8 +249,16 @@ let parse_request_uri_host_traversal _ = parse_request_uri_ r uri "parse_request_uri_host_traversal" let uri_round_trip _ = - let expected_uri = Uri.of_string "https://www.example.com/test" in - let actual_uri = Request.make expected_uri |> Request.uri in + let expected_uri = + let uri = Uri.of_string "https://www.example.com/test" in + Uri.with_userinfo uri (Some "foo") + in + let actual_uri = + let uri = Request.make expected_uri |> Request.uri in + (* These are the fields that aren't preserved: *) + let uri = Uri.with_scheme uri (Uri.scheme expected_uri) in + Uri.with_userinfo uri (Uri.userinfo expected_uri) + in Alcotest.check uri_testable "Request.make uri round-trip" actual_uri expected_uri diff --git a/http/src/http.ml b/http/src/http.ml index 63a684c0c..b90e11b24 100644 --- a/http/src/http.ml +++ b/http/src/http.ml @@ -739,27 +739,22 @@ module Request = struct type t = { headers : Header.t; (** HTTP request headers *) meth : Method.t; (** HTTP request method *) - scheme : string option; (** URI scheme (http or https) *) resource : string; (** Request path and query *) version : Version.t; (** HTTP version, usually 1.1 *) } let headers t = t.headers let meth t = t.meth - let scheme t = t.scheme let resource t = t.resource let version t = t.version - let compare { headers; meth; scheme; resource; version } y = + let compare { headers; meth; resource; version } y = match Header.compare headers y.headers with | 0 -> ( match Method.compare meth y.meth with | 0 -> ( - match Option.compare String.compare scheme y.scheme with - | 0 -> ( - match String.compare resource y.resource with - | 0 -> Version.compare version y.version - | i -> i) + match String.compare resource y.resource with + | 0 -> Version.compare version y.version | i -> i) | i -> i) | i -> i @@ -786,8 +781,8 @@ module Request = struct else `No let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(headers = Header.empty) - ?scheme resource = - { headers; meth; scheme; resource; version } + resource = + { headers; meth; resource; version } let pp fmt t = let open Format in @@ -1133,7 +1128,7 @@ module Parser = struct let path = token source in let version = version source in let headers = headers source in - { Request.headers; meth; scheme = None; resource = path; version } + { Request.headers; meth; resource = path; version } type error = Partial | Msg of string diff --git a/http/src/http.mli b/http/src/http.mli index b11e74f1c..b2ddc0870 100644 --- a/http/src/http.mli +++ b/http/src/http.mli @@ -385,7 +385,6 @@ module Request : sig type t = { headers : Header.t; (** HTTP request headers *) meth : Method.t; (** HTTP request method *) - scheme : string option; (** URI scheme (http or https) *) resource : string; (** Request path and query *) version : Version.t; (** HTTP version, usually 1.1 *) } @@ -393,7 +392,6 @@ module Request : sig val has_body : t -> [ `No | `Unknown | `Yes ] val headers : t -> Header.t val meth : t -> Method.t - val scheme : t -> string option val resource : t -> string val version : t -> Version.t val compare : t -> t -> int @@ -428,17 +426,11 @@ module Request : sig that a user-agent can handle HTTP chunked trailers headers. *) val make : - ?meth:Method.t -> - ?version:Version.t -> - ?headers:Header.t -> - ?scheme:string -> - string -> - t + ?meth:Method.t -> ?version:Version.t -> ?headers:Header.t -> string -> t (** [make resource] is a value of {!type:t}. The default values for the response, if not specified, are as follows: [meth] is [`GET], [version] is - [`HTTP_1_1], [headers] is [Header.empty] and [scheme] is [None]. The - request encoding value is determined via the - [Header.get_transfer_encoding] function.*) + [`HTTP_1_1], [headers] is [Header.empty]. The request encoding value is + determined via the [Header.get_transfer_encoding] function.*) val pp : Format.formatter -> t -> unit end diff --git a/http/test/test_parser.ml b/http/test/test_parser.ml index 8db9159f5..d2c33f7dc 100644 --- a/http/test/test_parser.ml +++ b/http/test/test_parser.ml @@ -38,7 +38,7 @@ let assert_req_success ~here ~expected_req ~expected_consumed ?pos ?len buf = [%test_result: int] ~here ~expect:expected_consumed consumed let[@warning "-3"] make_req ~headers meth resource = - { Http.Request.headers; meth; resource; scheme = None; version = `HTTP_1_1 } + { Http.Request.headers; meth; resource; version = `HTTP_1_1 } let req_expected = make_req