Remove special treatment of "host" header

CHANGES.md

@@ -1,4 +1,5 @@
 ## v6.0.0~alpha2 (2023-07-1)
+- http.header, cohttp, cohttp-eio: remove "first" and "move_to_first" and the special treatment of the "host" header (mseri #988)
 - http.header: introduce "iter_ord" to guarantee iteration following the order of the entries in the headers (mseri #986)
 - http.header: fix "move_to_fist" and "first" ro follow Header's semantics (mseri #986)
 - cohttp: ensure "host" is the first header (mseri #986)

cohttp-eio/src/client.ml

@@ -41,7 +41,6 @@ let write_request pipeline_requests request writer body =
       body
   in
   let headers = Http.Header.clean_dup headers 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;

cohttp-eio/tests/client.md

@@ -44,8 +44,8 @@ GET method request:
       |> Client.read_fixed
       |> print_string);;
 +socket: wrote "GET / HTTP/1.1\r\n"
-+              "Host: localhost\r\n"
 +              "Accept: application/json\r\n"
++              "Host: localhost\r\n"
 +              "User-Agent: cohttp-eio\r\n"
 +              "TE: trailers\r\n"
 +              "Connection: TE\r\n"
@@ -82,9 +82,9 @@ POST request:
       |> Client.read_fixed
       |> print_string);;
 +socket: wrote "POST /post HTTP/1.1\r\n"
-+              "Host: localhost\r\n"
 +              "Accept: application/json\r\n"
 +              "Content-Length: 12\r\n"
++              "Host: localhost\r\n"
 +              "User-Agent: cohttp-eio\r\n"
 +              "TE: trailers\r\n"
 +              "Connection: TE\r\n"
@@ -158,10 +158,10 @@ Chunk request:
       |> Client.read_fixed
       |> print_string);;
 +socket: wrote "POST /handle_chunk HTTP/1.1\r\n"
-+              "Host: localhost\r\n"
 +              "Transfer-Encoding: chunked\r\n"
 +              "Content-Type: text/plain\r\n"
 +              "Trailer: Expires, Header1\r\n"
++              "Host: localhost\r\n"
 +              "User-Agent: cohttp-eio\r\n"
 +              "TE: trailers\r\n"
 +              "Connection: TE\r\n"

cohttp-lwt-unix/test/test_parser.ml

@@ -270,7 +270,7 @@ let make_simple_req () =
   let open Cohttp in
   let open Cohttp_lwt_unix in
   let expected =
-    "POST /foo/bar HTTP/1.1\r\nhost: localhost\r\nFoo: bar\r\nuser-agent: "
+    "POST /foo/bar HTTP/1.1\r\nFoo: bar\r\nhost: localhost\r\nuser-agent: "
     ^ user_agent
     ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
   in
@@ -285,7 +285,7 @@ let mutate_simple_req () =
   let open Cohttp in
   let open Cohttp_lwt_unix in
   let expected =
-    "POST /foo/bar HTTP/1.1\r\nhost: localhost\r\nfoo: bar\r\nuser-agent: "
+    "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "
     ^ user_agent
     ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
   in

cohttp/src/request.ml

@@ -61,7 +61,6 @@ let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(encoding = Transfer.Unknown)
           ^
           match Uri.port uri with Some p -> ":" ^ string_of_int p | None -> ""))
   in
-  let headers = Header.Private.move_to_front headers "host" in
   let headers =
     Header.add_unless_exists headers "user-agent" Header.user_agent
   in
@@ -204,7 +203,6 @@ module Make (IO : S.IO) = struct
         Header.add_transfer_encoding headers req.encoding
       else headers
     in
-    let headers = Header.Private.move_to_front headers "host" in
     IO.write oc fst_line >>= fun _ -> Header_IO.write headers oc
 
   let make_body_writer ?flush req oc =

cohttp/test/test_request.ml

@@ -321,8 +321,8 @@ let null_content_length_header () =
   Alcotest.(check string)
     "null content-length header are sent"
     "PUT / HTTP/1.1\r\n\
-     host: someuri.com\r\n\
      user-agent: ocaml-cohttp\r\n\
+     host: someuri.com\r\n\
      content-length: 0\r\n\
      \r\n"
     (Buffer.to_string output)

http/src/http.ml

@@ -14,51 +14,56 @@ module Transfer = struct
 end
 
 module Header = struct
-  external string_unsafe_get64 : string -> int -> int64 = "%caml_string_get64u"
+  module Private = struct
+    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
-        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
+    (* [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. *)
         &&
-        let i' = i + 1 in
-        i' = len || byte_loop a b i' len
-      in
-      word_loop a b 0 len
+        (* [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
+              (* 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
 
   type t = (string * string) list
 
@@ -103,8 +108,6 @@ module Header = struct
     in
     loop h
 
-  let first t = match t with [] -> None | (k, v) :: _ -> Some (k, v)
-
   let get_multi (h : t) (k : string) =
     let rec loop h acc =
       match h with
@@ -161,22 +164,6 @@ module Header = struct
         let h = remove h k in
         add_multi h k xs
 
-  let move_to_front t hdr_name =
-    (* Headers are manipulated in reverse order for convenience, so we
-       need to reverse them, prepend what we need, and reverse again *)
-    let t = List.rev t in
-    let t =
-      match t with
-      | (k, _) :: _ when caseless_equal k hdr_name -> t
-      | _ -> (
-          match get t hdr_name with
-          | Some v ->
-              let headers = remove t hdr_name in
-              add headers hdr_name v
-          | None -> t)
-    in
-    List.rev t
-
   let map (f : string -> string -> string) (h : t) : t =
     List.map
       (fun (k, v) ->
@@ -186,7 +173,7 @@ module Header = struct
 
   let iter_ord (f : string -> string -> unit) (h : t) : unit =
     List.iter (fun (k, v) -> f k v) (List.rev h)
-  
+
   let iter (f : string -> string -> unit) (h : t) : unit =
     List.iter (fun (k, v) -> f k v) h
 
@@ -355,12 +342,6 @@ 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 l = first (List.rev l)
-    let move_to_front = move_to_front
-  end
 end
 
 module Status = struct

http/src/http.mli

@@ -309,11 +309,12 @@ module Header : sig
         [h] is returned unchanged. *)
 
   val iter_ord : (string -> string -> unit) -> t -> unit
-  (** [iter_ord f h] applies [f] to all the headers of [h] following the header order. *)
-
+  (** [iter_ord f h] applies [f] to all the headers of [h] following the header
+      order. *)
+
   val iter : (string -> string -> unit) -> t -> unit
-  (** [iter f h] applies [f] to all the headers of [h] following an unspecified order. 
-      This function is faster than iter_ord. *)
+  (** [iter f h] applies [f] to all the headers of [h] following an unspecified
+      order. This function is faster than iter_ord. *)
 
   val map : (string -> string -> string) -> t -> t
   val fold : (string -> string -> 'a -> 'a) -> t -> 'a -> 'a
@@ -377,15 +378,6 @@ 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

@@ -167,24 +167,6 @@ let replace_tests () =
     ]
     H.(to_list (replace prebuilt "accept" "text/*"))
 
-let move_to_front_tests () =
-  let headers1 = [ ("accept", "text/*"); ("Host", "www.example.com") ] in
-  let headers2 =
-    [
-      ("content-length", "23"); ("Host", "www.example.com"); ("accept", "text/*");
-    ]
-  in
-  aeso {|move_to_front h "Host"|} (Some "Host")
-    (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.(Private.move_to_front (H.of_list headers2) "Host" |> Private.first)
-     |> function
-     | Some (k, _) -> Some k
-     | None -> Some "")
-
 let h =
   H.init () |> fun h ->
   H.add h "first" "1" |> fun h ->
@@ -398,7 +380,6 @@ let tests =
       ("Header.iter", `Quick, iter_tests);
       ("Header.update", `Quick, update_tests);
       ("Header.update_all", `Quick, update_all_tests);
-      ("Header.move_to_front", `Quick, move_to_front_tests);
       ("many headers", `Slow, many_headers);
       ("transfer encoding is in correct order", `Quick, transfer_encoding_tests);
     ]