Vendors/Resto: allow passing custom headers in requests

This commit is contained in:
Benjamin Canou 2018-06-20 18:09:10 +02:00
parent 5e0822eb22
commit daaaf75e67
2 changed files with 16 additions and 6 deletions

View File

@ -120,9 +120,16 @@ module Make (Encoding : Resto.ENCODING) = struct
| `Stream s -> `Stream (Lwt_stream.clone s) | `Stream s -> `Stream (Lwt_stream.clone s)
| x -> x | 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 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 begin
match body with match body with
| None-> | None->
@ -255,12 +262,12 @@ module Make (Encoding : Resto.ENCODING) = struct
Lwt.return (log, meth, uri, body, media) Lwt.return (log, meth, uri, body, media)
let call_service media_types let call_service media_types
?logger ?base service params query body = ?logger ?headers ?base service params query body =
prepare prepare
media_types ?logger ?base media_types ?logger ?base
service params query body >>= fun (log, meth, uri, body, media) -> service params query body >>= fun (log, meth, uri, body, media) ->
begin begin
generic_call ~accept:media_types meth ?body ?media uri >>= function generic_call ?headers ~accept:media_types meth ?body ?media uri >>= function
| `Ok None -> | `Ok None ->
log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () -> log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->
Lwt.return (`Ok None) Lwt.return (`Ok None)
@ -298,12 +305,12 @@ module Make (Encoding : Resto.ENCODING) = struct
Lwt.return (meth, uri, ans) Lwt.return (meth, uri, ans)
let call_streamed_service media_types 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 prepare
media_types ?logger ?base media_types ?logger ?base
service params query body >>= fun (log, meth, uri, body, media) -> service params query body >>= fun (log, meth, uri, body, media) ->
begin begin
generic_call ~accept:media_types meth ?body ?media uri >>= function generic_call ?headers ~accept:media_types meth ?body ?media uri >>= function
| `Ok None -> | `Ok None ->
on_close () ; on_close () ;
log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () -> log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->

View File

@ -54,6 +54,7 @@ module Make (Encoding : Resto.ENCODING) : sig
val generic_call: val generic_call:
[< Resto.meth ] -> [< Resto.meth ] ->
?logger:logger -> ?logger:logger ->
?headers:(string * string) list ->
?accept:Media_type.Make(Encoding).t list -> ?accept:Media_type.Make(Encoding).t list ->
?body:Cohttp_lwt.Body.t -> ?body:Cohttp_lwt.Body.t ->
?media:Media_type.Make(Encoding).t -> ?media:Media_type.Make(Encoding).t ->
@ -69,6 +70,7 @@ module Make (Encoding : Resto.ENCODING) : sig
val call_service: val call_service:
Media_type.Make(Encoding).t list -> Media_type.Make(Encoding).t list ->
?logger:logger -> ?logger:logger ->
?headers:(string * string) list ->
?base:Uri.t -> ?base:Uri.t ->
([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t -> ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
'p -> 'q -> 'i -> (Resto.meth * Uri.t * ('o, 'e) service_result) Lwt.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: val call_streamed_service:
Media_type.Make(Encoding).t list -> Media_type.Make(Encoding).t list ->
?logger:logger -> ?logger:logger ->
?headers:(string * string) list ->
?base:Uri.t -> ?base:Uri.t ->
([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t -> ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
on_chunk: ('o -> unit) -> on_chunk: ('o -> unit) ->