Skip to content

Commit

Permalink
feature: remove [scheme] from requests
Browse files Browse the repository at this point in the history
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 <[email protected]>

<!-- ps-id: eab21598-332e-4541-9530-fe5ca05e2d06 -->
  • Loading branch information
rgrinberg committed Sep 4, 2024
1 parent f43be8f commit f2932ca
Show file tree
Hide file tree
Showing 7 changed files with 62 additions and 79 deletions.
3 changes: 3 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -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 ..)
- 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)
Expand Down
91 changes: 39 additions & 52 deletions cohttp/src/request.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down
2 changes: 0 additions & 2 deletions cohttp/src/s.ml
Original file line number Diff line number Diff line change
Expand Up @@ -85,15 +85,13 @@ 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 *)
}
[@@deriving sexp]

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
Expand Down
12 changes: 10 additions & 2 deletions cohttp/test/test_request.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
17 changes: 6 additions & 11 deletions http/src/http.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
14 changes: 3 additions & 11 deletions http/src/http.mli
Original file line number Diff line number Diff line change
Expand Up @@ -385,15 +385,13 @@ 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 *)
}

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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion http/test/test_parser.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit f2932ca

Please sign in to comment.