Skip to content

Commit

Permalink
http: move first and move_to_first to Private
Browse files Browse the repository at this point in the history
  • Loading branch information
bikallem committed Sep 17, 2022
1 parent ed915d8 commit 3313312
Show file tree
Hide file tree
Showing 5 changed files with 71 additions and 69 deletions.
7 changes: 3 additions & 4 deletions cohttp-eio/src/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -74,16 +74,15 @@ let response buf_read =

let call ?meth ?version ?(headers = Http.Header.init ()) ?(body = Body.Empty)
~conn host resource_path =
let host_hdr = "Host" in
let headers =
if not (Http.Header.mem headers host_hdr) then
if not (Http.Header.mem headers "Host") then
let host =
match host with
| host, Some port -> host ^ ":" ^ string_of_int port
| host, None -> host
in
Http.Header.add headers host_hdr host
else Http.Header.move_to_front headers host_hdr
Http.Header.add headers "Host" host
else headers
in
let headers =
Http.Header.add_unless_exists headers "User-Agent" "cohttp-eio"
Expand Down
12 changes: 6 additions & 6 deletions cohttp-eio/tests/test_client.t
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,8 @@ Test Client.get
resource: /get
version: HTTP/1.1
headers: Header {
Accept = "application/json"; Host = "localhost:8082";
User-Agent = "cohttp-eio" }
Accept = "application/json"; User-Agent = "cohttp-eio";
Host = "localhost:8082" }

$ kill ${running_pid}

Expand All @@ -23,8 +23,8 @@ Test Client.post
resource: /post
version: HTTP/1.1
headers: Header {
Accept = "application/json"; Content-Length = "12"; Host = "localhost:8082";
User-Agent = "cohttp-eio" }
Accept = "application/json"; Content-Length = "12";
User-Agent = "cohttp-eio"; Host = "localhost:8082" }

hello world!

Expand All @@ -41,8 +41,8 @@ Test posting "chunked" data
version: HTTP/1.1
headers: Header {
Content-Length = "23"; Header1 = "Header1 value text";
Content-Type = "text/plain"; Host = "localhost:8082";
User-Agent = "cohttp-eio" }
Content-Type = "text/plain"; User-Agent = "cohttp-eio";
Host = "localhost:8082" }

size: 7
data: Mozilla
Expand Down
97 changes: 49 additions & 48 deletions http/src/http.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,56 +14,51 @@ module Transfer = struct
end

module Header = struct
module Private = struct
external string_unsafe_get64 : string -> int -> int64
= "%caml_string_get64u"
external string_unsafe_get64 : string -> int -> int64 = "%caml_string_get64u"

(* [caseless_equal a b] must be equivalent to
[String.equal (String.lowercase_ascii a) (String.lowercase_ascii b)]. *)
let caseless_equal a b =
if a == b then true
else
let len = String.length a in
len = String.length b
(* Note: at this point we konw that [a] and [b] have the same length. *)
&&
(* [word_loop a b i len] compares strings [a] and [b] from
offsets [i] (included) to [len] (excluded), one word at a time.
[i] is a world-aligned index into the strings.
*)
let rec word_loop a b i len =
if i = len then true
(* [caseless_equal a b] must be equivalent to
[String.equal (String.lowercase_ascii a) (String.lowercase_ascii b)]. *)
let caseless_equal a b =
if a == b then true
else
let len = String.length a in
len = String.length b
(* Note: at this point we konw that [a] and [b] have the same length. *)
&&
(* [word_loop a b i len] compares strings [a] and [b] from
offsets [i] (included) to [len] (excluded), one word at a time.
[i] is a world-aligned index into the strings.
*)
let rec word_loop a b i len =
if i = len then true
else
let i' = i + 8 in
(* If [i' > len], what remains to be compared is strictly
less than a word long, use byte-per-byte comparison. *)
if i' > len then byte_loop a b i len
else if string_unsafe_get64 a i = string_unsafe_get64 b i then
word_loop a b i' len
else
let i' = i + 8 in
(* If [i' > len], what remains to be compared is strictly
less than a word long, use byte-per-byte comparison. *)
if i' > len then byte_loop a b i len
else if string_unsafe_get64 a i = string_unsafe_get64 b i then
word_loop a b i' len
else
(* If the words at [i] differ, it may due to a case
difference; we check the individual bytes of this
work, and then we continue checking the other
words. *)
byte_loop a b i i' && word_loop a b i' len
(* [byte_loop a b i len] compares the strings [a] and [b] from
offsets [i] (included) to [len] (excluded), one byte at
a time.
This function assumes that [i < len] holds -- its only called
by [word_loop] when this is known to hold. *)
and byte_loop a b i len =
let c1 = String.unsafe_get a i in
let c2 = String.unsafe_get b i in
Char.lowercase_ascii c1 = Char.lowercase_ascii c2
&&
let i' = i + 1 in
i' = len || byte_loop a b i' len
in
word_loop a b 0 len
end

let caseless_equal = Private.caseless_equal
(* If the words at [i] differ, it may due to a case
difference; we check the individual bytes of this
work, and then we continue checking the other
words. *)
byte_loop a b i i' && word_loop a b i' len
(* [byte_loop a b i len] compares the strings [a] and [b] from
offsets [i] (included) to [len] (excluded), one byte at
a time.
This function assumes that [i < len] holds -- its only called
by [word_loop] when this is known to hold. *)
and byte_loop a b i len =
let c1 = String.unsafe_get a i in
let c2 = String.unsafe_get b i in
Char.lowercase_ascii c1 = Char.lowercase_ascii c2
&&
let i' = i + 1 in
i' = len || byte_loop a b i' len
in
word_loop a b 0 len

type t = (string * string) list

Expand Down Expand Up @@ -351,6 +346,12 @@ module Header = struct
| Some v when v = "close" -> Some `Close
| Some x -> Some (`Unknown x)
| _ -> None

module Private = struct
let caseless_equal = caseless_equal
let first = first
let move_to_front = move_to_front
end
end

module Status = struct
Expand Down
18 changes: 9 additions & 9 deletions http/src/http.mli
Original file line number Diff line number Diff line change
Expand Up @@ -256,10 +256,6 @@ module Header : sig
(** [get h k] returns [Some v] where [v] is the last added value associated
with [k] in [h] if it exists and [None] otherwise *)

val first : t -> (string * string) option
(** [first t] is [Some (hdr_name, hdr_value)], which represents the first
header in headers list [t]. It is [None] if [t] is empty. *)

val get_multi : t -> string -> string list
(** [get_multi h k] returns a list of all values associated with [k] in [h] in
order they appear in it. *)
Expand Down Expand Up @@ -307,11 +303,6 @@ module Header : sig
- If [k] was already associated in [h] to a list that is equal to [vs],
[h] is returned unchanged. *)

val move_to_front : t -> string -> t
(** [move_to_front t hdr_name] is [t] with header name [hdr_name] moved to the
front of the headers list [t]. If the header doesn't exist in [t] or the
header is already at the front, then [t] is unchanged. *)

val iter : (string -> string -> unit) -> t -> unit
val map : (string -> string -> string) -> t -> t
val fold : (string -> string -> 'a -> 'a) -> t -> 'a -> 'a
Expand Down Expand Up @@ -375,6 +366,15 @@ module Header : sig
val caseless_equal : string -> string -> bool
(** [caseless_equal a b] must be equivalent to
[String.equal (String.lowercase_ascii a) (String.lowercase_ascii b)]. *)

val first : t -> (string * string) option
(** [first t] is [Some (hdr_name, hdr_value)], which represents the first
header in headers list [t]. It is [None] if [t] is empty. *)

val move_to_front : t -> string -> t
(** [move_to_front t hdr_name] is [t] with header name [hdr_name] moved to
the front of the headers list [t]. If the header doesn't exist in [t] or
the header is already at the front, then [t] is unchanged. *)
end
end

Expand Down
6 changes: 4 additions & 2 deletions http/test/test_header.ml
Original file line number Diff line number Diff line change
Expand Up @@ -175,11 +175,13 @@ let move_to_front_tests () =
]
in
aeso {|move_to_front h "Host"|} (Some "Host")
(H.(move_to_front (H.of_list headers1) "Host") |> H.first |> function
(H.(Private.move_to_front (H.of_list headers1) "Host" |> Private.first)
|> function
| Some (k, _) -> Some k
| None -> Some "");
aeso {|move_to_front h "Host"|} (Some "Host")
(H.(move_to_front (H.of_list headers2) "Host") |> H.first |> function
(H.(Private.move_to_front (H.of_list headers2) "Host" |> Private.first)
|> function
| Some (k, _) -> Some k
| None -> Some "")

Expand Down

0 comments on commit 3313312

Please sign in to comment.