Associative list implementation for headers

CHANGES.md

@@ -3,6 +3,39 @@
 - lwt_jsoo: Fix `Lwt.wakeup_exn` `Invalid_arg` exception when a js
  stack overflow happens in the XHR completion handler (@mefyl #762).
 
+- Revamped Header implementation (@lyrm #747)
+
+ + New implementation of Header modules using an associative list instead of a map, with one major semantic change (function ```get```, see below), and some new functions (```clean_dup```, ```get_multi_concat```)
+ + More Alcootest tests as well as fuzzing tests for this particular module.
+
+ ### Purpose
+
+ The new header implementation uses an associative list instead of a map to represent headers and is focused on predictibility and intuitivity: except for some specific and documented functions, the headers are always kept in transmission order, which makes debugging easier and is also important for [RFC7230§3.2.2](https://tools.ietf.org/html/rfc7230#section-3.2.2) that states that multiple values of a header must be kept in order.
+
+ Also, to get an intuitive function behaviour, no extra work to enforce RFCs is done by the basic functions. For example, RFC7230§3.2.2 requires that a sender does not send multiple values for a non list-value header. This particular rule could require the ```Header.add``` function to remove previous values of non-list-value headers, which means some changes of the headers would be out of control of the user. With the current implementation, an user has to actively call dedicated functions to enforce such RFCs (here ```Header.clean_dup```).
+
+ ### Semantic changes
+ Two functions have a semantic change : ```get``` and ```update```.
+
+ #### get
+ ```get``` was previously doing more than just returns the value associated to a key; it was also checking if the searched header could have multiple values: if not, the last value associated to the header was returned; otherwise, all the associated values were concatenated and returned. This semantics does not match the global idea behind the new header implementation, and would also be very unefficient.
+
+ + The new ```get``` function only returns the last value associated to the searched header.
+ + ```get_multi_concat``` function has been added to get a result similar to the previous ```get``` function.
+
+ #### update
+ ```update``` is a pretty new function (#703) and changes are minor and related to ```get``` semantic changes.
+
+ + ```update h k f``` is now modifying only the last occurences of the header ```k``` instead of all its occurrences.
+ + a new function ```update_all``` function has been added and work on all the occurrences of the updated header.
+
+ ### New functions :
+
+ + ```clean_dup``` enables the user to clean headers that follows the {{:https://tools.ietf.org/html/rfc7230#section-3.2.2} RFC7230§3.2.2} (no duplicate, except ```set-cookie```)
+ + ```get_multi_concat``` has been added to get a result similar to the previous ```get``` function.
+
+
+
 ## v4.0.0 (2021-03-24)
 
 - cohttp.response: fix malformed status header for custom status codes (@mseri @aalekseyev #752)

cohttp-async/bin/cohttp_curl_async.ml

@@ -19,10 +19,7 @@ open Async_kernel
 open Cohttp_async
 
 let show_headers h =
- Cohttp.Header.iter
- (fun k v ->
- List.iter v ~f:(fun v_i -> Logs.info (fun m -> m "%s: %s%!" k v_i)))
- h
+ Cohttp.Header.iter (fun k v -> Logs.info (fun m -> m "%s: %s%!" k v)) h
 
 let make_net_req uri meth' body () =
  let meth = Cohttp.Code.method_of_string meth' in

cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml

@@ -182,9 +182,7 @@ module Make_client_async (P : Params) = Make_api (struct
  (fun k v ->
  (* some headers lead to errors in the javascript console, should
  we filter then out here? *)
- List.iter
- (fun v -> xml ## (setRequestHeader (Js.string k) (Js.string v)))
- v)
+ xml ## (setRequestHeader (Js.string k) (Js.string v)))
  headers
  in
 
@@ -291,12 +289,9 @@ module Make_client_sync (P : Params) = Make_api (struct
  | Some headers ->
  C.Header.iter
  (fun k v ->
- List.iter
- (* some headers lead to errors in the javascript console, should
- we filter then out here? *)
- (fun v ->
- xml ## (setRequestHeader (Js.string k) (Js.string v)))
- v)
+ (* some headers lead to errors in the javascript console, should
+ we filter then out here? *)
+ xml ## (setRequestHeader (Js.string k) (Js.string v)))
  headers
  in
  (* perform call *)

cohttp-lwt-unix/test/test_parser.ml

@@ -24,6 +24,8 @@ let basic_res =
  Server: Apache/1.3.3.7 (Unix) (Red-Hat/Linux)\r\n\
  Last-Modified: Wed, 08 Jan 2003 23:11:55 GMT\r\n\
  Etag: \"3f80f-1b6-3e1cb03b\"\r\n\
+ Accept: text/*\r\n\
+ Accept: application/xml\r\n\
  Accept-Ranges: none\r\n\
  Content-Length: 0\r\n\
  Connection: close\r\n\
@@ -244,13 +246,9 @@ let make_simple_req () =
  let open Cohttp in
  let open Cohttp_lwt_unix in
  let expected =
- "POST /foo/bar HTTP/1.1\r\n\
- foo: bar\r\n\
- host: localhost\r\n\
- transfer-encoding: chunked\r\n\
- user-agent: "
+ "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "
  ^ user_agent
- ^ "\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
+ ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
  in
  let req =
  Request.make ~encoding:Transfer.Chunked ~meth:`POST
@@ -263,13 +261,9 @@ let mutate_simple_req () =
  let open Cohttp in
  let open Cohttp_lwt_unix in
  let expected =
- "POST /foo/bar HTTP/1.1\r\n\
- foo: bar\r\n\
- host: localhost\r\n\
- transfer-encoding: chunked\r\n\
- user-agent: "
+ "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "
  ^ user_agent
- ^ "\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
+ ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
  in
  let req =
  Request.make ~encoding:Transfer.Chunked

cohttp.opam

@@ -44,6 +44,7 @@ depends: [
  "fmt" {with-test}
  "jsonm" {build}
  "alcotest" {with-test}
+ "crowbar" {with-test}
 ]
 build: [
  ["dune" "subst"] {dev}

cohttp/fuzz/dune

@@ -0,0 +1,26 @@
+(executable
+ (name fuzz_header)
+ (libraries crowbar cohttp))
+
+(rule
+ (alias runtest)
+ (package cohttp)
+ (action
+ (run ./fuzz_header.exe)))
+
+(rule
+ (alias fuzz)
+ (deps
+ (:exe fuzz_header.exe)
+ (source_tree inputs))
+ (action
+ (run afl-fuzz -i inputs -o findings -- ./%{exe} @@)))
+
+(rule
+ (alias bun-fuzz)
+ (locks %{project_root}/bun)
+ (deps
+ (:exe fuzz_me.exe)
+ (source_tree input))
+ (action
+ (run bun --input inputs --output findings -- ./%{exe})))