From daaaf75e67cdd900a5bacb04b5b04014a893ef1f Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Wed, 20 Jun 2018 18:09:10 +0200
Subject: [PATCH] Vendors/Resto: allow passing custom headers in requests

---
 .../ocplib-resto/lib_resto-cohttp/client.ml   | 19 +++++++++++++------
 .../ocplib-resto/lib_resto-cohttp/client.mli  |  3 +++
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/vendors/ocplib-resto/lib_resto-cohttp/client.ml b/vendors/ocplib-resto/lib_resto-cohttp/client.ml
index ae6a6fe1a..c03c4e726 100644
--- a/vendors/ocplib-resto/lib_resto-cohttp/client.ml
+++ b/vendors/ocplib-resto/lib_resto-cohttp/client.ml
@@ -120,9 +120,16 @@ module Make (Encoding : Resto.ENCODING) = struct
     | `Stream s -> `Stream (Lwt_stream.clone s)
     | x -> x
 
-  let generic_call meth ?(logger = null_logger) ?accept ?body ?media uri : (content, content) generic_rest_result Lwt.t =
+  let generic_call meth ?(logger = null_logger) ?(headers = []) ?accept ?body ?media uri : (content, content) generic_rest_result Lwt.t =
     let module Logger = (val logger) in
-    let headers = Header.init () in
+    let headers = List.fold_left (fun headers (header, value) ->
+        if String.length header < 2
+        || String.sub (String.lowercase_ascii header) 0 2 <> "x-" then
+          invalid_arg
+            "Resto_cohttp.Client.call: \
+             only headers starting with \"x-\" are supported"
+        else Header.add headers header value)
+        (Header.init ()) headers in
     begin
       match body with
       | None->
@@ -255,12 +262,12 @@ module Make (Encoding : Resto.ENCODING) = struct
     Lwt.return (log, meth, uri, body, media)
 
   let call_service media_types
-      ?logger ?base service params query body =
+      ?logger ?headers ?base service params query body =
     prepare
       media_types ?logger ?base
       service params query body >>= fun (log, meth, uri, body, media) ->
     begin
-      generic_call ~accept:media_types meth ?body ?media uri >>= function
+      generic_call ?headers ~accept:media_types meth ?body ?media uri >>= function
       | `Ok None ->
           log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->
           Lwt.return (`Ok None)
@@ -298,12 +305,12 @@ module Make (Encoding : Resto.ENCODING) = struct
     Lwt.return (meth, uri, ans)
 
   let call_streamed_service media_types
-      ?logger ?base service ~on_chunk ~on_close params query body =
+      ?logger ?headers ?base service ~on_chunk ~on_close params query body =
     prepare
       media_types ?logger ?base
       service params query body >>= fun (log, meth, uri, body, media) ->
     begin
-      generic_call ~accept:media_types meth ?body ?media uri >>= function
+      generic_call ?headers ~accept:media_types meth ?body ?media uri >>= function
       | `Ok None ->
           on_close () ;
           log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->
diff --git a/vendors/ocplib-resto/lib_resto-cohttp/client.mli b/vendors/ocplib-resto/lib_resto-cohttp/client.mli
index 0fa353309..b0ef42dbc 100644
--- a/vendors/ocplib-resto/lib_resto-cohttp/client.mli
+++ b/vendors/ocplib-resto/lib_resto-cohttp/client.mli
@@ -54,6 +54,7 @@ module Make (Encoding : Resto.ENCODING) : sig
   val generic_call:
     [< Resto.meth ] ->
     ?logger:logger ->
+    ?headers:(string * string) list ->
     ?accept:Media_type.Make(Encoding).t list ->
     ?body:Cohttp_lwt.Body.t ->
     ?media:Media_type.Make(Encoding).t ->
@@ -69,6 +70,7 @@ module Make (Encoding : Resto.ENCODING) : sig
   val call_service:
     Media_type.Make(Encoding).t list ->
     ?logger:logger ->
+    ?headers:(string * string) list ->
     ?base:Uri.t ->
     ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
     'p -> 'q -> 'i -> (Resto.meth * Uri.t * ('o, 'e) service_result) Lwt.t
@@ -76,6 +78,7 @@ module Make (Encoding : Resto.ENCODING) : sig
   val call_streamed_service:
     Media_type.Make(Encoding).t list ->
     ?logger:logger ->
+    ?headers:(string * string) list ->
     ?base:Uri.t ->
     ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
     on_chunk: ('o -> unit) ->