Client: temporary hack

reaggregate http chunks for streamed RPC... :(
This commit is contained in:
Grégoire Henry 2018-04-17 10:35:01 +02:00
parent ec25690166
commit aeaf2a240c

View File

@ -319,28 +319,23 @@ module Make (Encoding : Resto.ENCODING) = struct
on_close () ; on_close () ;
Lwt.return (`Ok None) Lwt.return (`Ok None)
| Some chunk -> | Some chunk ->
let buffer = Buffer.create 2048 in
let output = Service.output_encoding service in let output = Service.output_encoding service in
log.log ~media output let rec loop = function
`OK (lazy (Lwt.return chunk)) >>= fun () ->
match media.destruct output chunk with
| Error msg ->
Lwt.return (`Unexpected_content ((chunk, media), msg))
| Ok body ->
on_chunk body ;
let rec loop () =
Lwt_stream.get stream >>= function
| None -> on_close () ; Lwt.return_unit | None -> on_close () ; Lwt.return_unit
| Some chunk -> | Some chunk ->
Buffer.add_string buffer chunk ;
let data = Buffer.contents buffer in
log.log ~media output log.log ~media output
`OK (lazy (Lwt.return chunk)) >>= fun () -> `OK (lazy (Lwt.return chunk)) >>= fun () ->
match media.destruct output chunk with match media.destruct output data with
| Ok body -> on_chunk body ; loop () | Ok body ->
Buffer.reset buffer ;
on_chunk body ;
Lwt_stream.get stream >>= loop
| Error _msg -> | Error _msg ->
(* TODO log error. *) Lwt_stream.get stream >>= loop in
ignore (Lwt_stream.junk_while (fun _ -> true) stream ignore (loop (Some chunk) : unit Lwt.t) ;
: unit Lwt.t) ;
on_close () ; Lwt.return_unit in
ignore (loop () : unit Lwt.t) ;
Lwt.return (`Ok (Some (fun () -> Lwt.return (`Ok (Some (fun () ->
ignore (Lwt_stream.junk_while (fun _ -> true) stream ignore (Lwt_stream.junk_while (fun _ -> true) stream
: unit Lwt.t) ; : unit Lwt.t) ;