balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: temporary hack

Browse Source 
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
1 changed files with 20 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
vendors/ocplib-resto/lib_resto-cohttp/client.ml vendored
View File

@ -319,32 +319,27 @@ 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 () -> | None -> on_close () ; Lwt.return_unit
match media.destruct output chunk with | Some chunk ->
| Error msg -> Buffer.add_string buffer chunk ;
Lwt.return (`Unexpected_content ((chunk, media), msg)) let data = Buffer.contents buffer in
| Ok body -> log.log ~media output
on_chunk body ; `OK (lazy (Lwt.return chunk)) >>= fun () ->
let rec loop () = match media.destruct output data with
Lwt_stream.get stream >>= function | Ok body ->
| None -> on_close () ; Lwt.return_unit Buffer.reset buffer ;
| Some chunk -> on_chunk body ;
log.log ~media output Lwt_stream.get stream >>= loop
`OK (lazy (Lwt.return chunk)) >>= fun () -> | Error _msg ->
match media.destruct output chunk with Lwt_stream.get stream >>= loop in
| Ok body -> on_chunk body ; loop () ignore (loop (Some chunk) : unit Lwt.t) ;
| Error _msg -> Lwt.return (`Ok (Some (fun () ->
(* TODO log error. *) ignore (Lwt_stream.junk_while (fun _ -> true) stream
ignore (Lwt_stream.junk_while (fun _ -> true) stream : unit Lwt.t) ;
: unit Lwt.t) ; ())))
on_close () ; Lwt.return_unit in
ignore (loop () : unit Lwt.t) ;
Lwt.return (`Ok (Some (fun () ->
ignore (Lwt_stream.junk_while (fun _ -> true) stream
: unit Lwt.t) ;
())))
end end
| `Conflict body -> | `Conflict body ->
handle_error log service body `Conflict (fun v -> `Conflict v) handle_error log service body `Conflict (fun v -> `Conflict v)