cohttp: revert change to Header.replace, add Header.update

CHANGES.md

@@ -1,3 +1,9 @@
+## Unreleased
+
+- cohttp: a change in #694 modified the semantics of Header.replace.
+  The semantics change is reverted, and a new Header.update function
+  is introduced, following the semantics of Map.update. (#702 @mseri)
+
 ## v2.5.3 (2020-06-27)
 
 - cohttp-async: adapt to async >= v0.14 (#699 @copy)

cohttp/src/header.ml

@@ -77,9 +77,25 @@ let remove h k =
 
 let replace h k v =
   let k = LString.of_string k in
-  if StringMap.mem k h
-  then StringMap.add k [v] h
-  else h
+  StringMap.add k [v] h
+
+let update h k f =
+  let k = LString.of_string k in
+  let f v =
+    let v' = match v with
+      | None -> f None
+      | Some l -> 
+        if is_header_with_list_value k then
+          f (Some (String.concat "," l))
+        else f (Some (List.hd l))
+    in match v' with
+    | None -> None
+    | Some s ->
+      if is_header_with_list_value k then
+        Some (String.split_on_char ',' s)
+      else Some [s]
+  in
+  StringMap.update k f h
 
 let get h k =
   let k = LString.of_string k in

cohttp/src/header.mli

@@ -56,10 +56,26 @@ val add_opt_unless_exists : t option -> string -> string -> t
     original header parameter is not modified. *)
 val remove : t -> string -> t
 
-(** Replace the value of a key from the header map if it exists. The
-   original header parameter is not modified. *)
+(** Replace the value of a key from the header map if it exists, otherwise it
+    adds it to the header map. The original header parameter is not modified. *)
 val replace : t -> string -> string -> t
 
+(** [update h k f] returns a map containing the same headers as [h],
+    except for the header [k]. Depending on the value of [v] where [v] is
+    [f (get h k)], the header [k] is added, removed or updated.
+    If [w] is [None], the header is removed if it exists; otherwise,
+    if [w] is [Some z] then [k] is associated to [z] in the resulting headers.
+    If [k] was already associated in [h] to a value that is physically equal
+    to [z], [h] is returned unchanged (the result of the function is then
+    physically equal to [h]). Similarly as for [get], if the header is one
+    of the set of headers defined to have list values, then all of the values are
+    concatenated into a single string separated by commas and passed to [f],
+    while the return value of [f] is split on commas and associated to [k].
+    If it is a singleton header, then the first value is passed to [f] and
+    no concatenation is performed, similarly for the return value.
+    The original header parameters are not modified. *)
+val update: t -> string -> (string option -> string option) -> t
+
 (** Check if a key exists in the header. *)
 val mem : t -> string -> bool
 

cohttp/test/test_header.ml

@@ -133,6 +133,37 @@ let many_headers () =
   let h = add_header size (H.init ()) in
   Alcotest.(check int) "many_headers" (List.length (H.to_list h)) size
 
+module Updates = struct
+  let h = H.init ()
+    |> fun h -> H.add h "first" "1"
+    |> fun h -> H.add h "second" "2"
+    |> fun h -> H.add h "accept" "foo"
+    |> fun h -> H.add h "accept" "bar"
+
+  let replace_headers_if_exists () =
+    let h = H.replace h "second" "2a" in
+    Alcotest.(check (option string)) "replace_existing_header" (Some "2a") (H.get h "second")
+
+  let replace_headers_if_absent () =
+    let h = H.replace h "third" "3" in
+    Alcotest.(check (option string)) "replace_new_header" (Some "3") (H.get h "third")
+
+  let update_headers_if_exists () =
+    let h1 = H.update h "second" (function | Some _ -> Some "2a" | None -> None) in
+    let h2 = H.replace h "second" "2a" in
+    Alcotest.(check t_header) "update_existing_header" h1 h2
+
+  let update_headers_if_exists_multi () =
+    let h1 = H.update h "accept" (function | Some v -> Some ("baz,"^v) | None -> None) in
+    let h2 = H.add h "accept" "baz" in
+    Alcotest.(check (option string)) "update_existing_header_multivalued" (H.get h1 "accept") (H.get h2 "accept")
+
+  let update_headers_if_absent () =
+    let h1 = H.update h "third" (function | Some _ -> Some "3" | None -> None) in
+    Alcotest.(check t_header) "update_new_header: unchanged" h h1;
+    Alcotest.(check (option string)) "update_new_header: map unchanged" None (H.get h "third")
+end
+
 module Content_range = struct
   let h1 = H.of_list ["Content-Length", "123"]
   let h2 = H.of_list ["Content-Range", "bytes 200-300/1000"]
@@ -484,6 +515,11 @@ Alcotest.run "test_header" [
   "Header", [
     "get list valued", `Quick, list_valued_header;
     "trim whitespace", `Quick, trim_ws;
+    "replace existing", `Quick, Updates.replace_headers_if_exists;
+    "replace absent", `Quick, Updates.replace_headers_if_absent;
+    "update existing", `Quick, Updates.update_headers_if_exists;
+    "update existing list", `Quick, Updates.update_headers_if_exists_multi;
+    "update absent", `Quick, Updates.update_headers_if_absent;
     "large header", `Slow, large_header;
     "many headers", `Slow, many_headers;
   ];