Http.Headers: fix semantics of 'first'

The headers are dealt with in reverse order for speed and reversed
once converted back to list. This means that to move an element to
the top of the headers we need to attach it to the bottom of the
list.  The  private method has been mofied accordingly.

The bug was spotted when fixing the null-header test to address the
lack of version in the user-agent header for development versions
of cohttp

Signed-off-by: Marcello Seri <[email protected]>

cohttp/src/request.ml

@@ -204,7 +204,9 @@ module Make (IO : S.IO) = struct
         Header.add_transfer_encoding headers req.encoding
       else headers
     in
+    print_endline (Header.to_string headers);
     let headers = Header.Private.move_to_front headers "host" in
+    print_endline (Header.to_string headers);
     IO.write oc fst_line >>= fun _ -> Header_IO.write headers oc
 
   let make_body_writer ?flush req oc =

cohttp/test/test_request.ml

@@ -308,8 +308,12 @@ module Request = Request.Private.Make (Test_io)
 let null_content_length_header () =
   let output = Buffer.create 1024 in
   let () =
+    (* The user-agent in releases contentsontains the version, we need to strip
+       it for the test *)
+    let headers = Cohttp.Header.of_list [ ("user-agent", "ocaml-cohttp") ] in
     let r =
-      Cohttp.Request.make_for_client ~chunked:false ~body_length:0L `PUT
+      Cohttp.Request.make_for_client ~headers ~chunked:false ~body_length:0L
+        `PUT
         (Uri.of_string "http://someuri.com")
     in
     Request.write_header r output
@@ -318,7 +322,7 @@ let null_content_length_header () =
     "null content-length header are sent"
     "PUT / HTTP/1.1\r\n\
      host: someuri.com\r\n\
-     user-agent: ocaml-cohttp/\r\n\
+     user-agent: ocaml-cohttp\r\n\
      content-length: 0\r\n\
      \r\n"
     (Buffer.to_string output)

http/src/http.ml

@@ -162,14 +162,20 @@ module Header = struct
         add_multi h k xs
 
   let move_to_front t hdr_name =
-    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)
+    (* 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
@@ -349,7 +355,7 @@ module Header = struct
 
   module Private = struct
     let caseless_equal = caseless_equal
-    let first = first
+    let first l = first (List.rev l)
     let move_to_front = move_to_front
   end
 end