http: move first and move_to_first to Private

Author: bikallem

cohttp-eio/src/client.ml

@@ -32,6 +32,7 @@ let write_request writer request body =
       (Http.Request.headers request)
       body
   in
+  let headers = Http.Header.Private.move_to_front headers "Host" in
   let meth = Http.Method.to_string @@ Http.Request.meth request in
   let version = Http.Version.to_string @@ Http.Request.version request in
   Buf_write.string writer meth;
@@ -72,16 +73,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 request = Http.Request.make ?meth ?version ~headers resource_path in
   Buf_write.with_flow ~initial_size:0x1000 conn (fun writer ->

http/src/http.ml

@@ -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
 
@@ -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

http/src/http.mli

@@ -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. *)
@@ -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
@@ -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
 

http/test/test_header.ml

@@ -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 "")