flush and wait

This commit is contained in:
Hannes Mehnert 2022-09-27 12:22:29 +02:00
parent 938da1a211
commit 007842f3d3

View file

@ -397,7 +397,9 @@ module Make
let rec read_more offset = let rec read_more offset =
if offset < len then if offset < len then
KV.get_partial t.dev key ~offset ~length:chunk_size >>= function KV.get_partial t.dev key ~offset ~length:chunk_size >>= function
| Ok data -> f data ; read_more (offset + chunk_size) | Ok data ->
f data >>= fun () ->
read_more (offset + chunk_size)
| Error e -> | Error e ->
Logs.err (fun m -> m "error %a while reading %s %s" Logs.err (fun m -> m "error %a while reading %s %s"
KV.pp_error e (hash_to_string h) v); KV.pp_error e (hash_to_string h) v);
@ -682,7 +684,11 @@ stamp: %S
let resp = Httpaf.Response.create ~headers `OK in let resp = Httpaf.Response.create ~headers `OK in
let body = Httpaf.Reqd.respond_with_streaming reqd resp in let body = Httpaf.Reqd.respond_with_streaming reqd resp in
Disk.read_chunked store h hash (fun chunk -> Disk.read_chunked store h hash (fun chunk ->
Httpaf.Body.write_string body chunk) >|= fun _ -> let wait, wakeup = Lwt.task () in
Httpaf.Body.write_string body chunk;
Httpaf.Body.flush body (Lwt.wakeup wakeup);
wait
) >|= fun _ ->
Httpaf.Body.close_writer body) Httpaf.Body.close_writer body)
end end
| _ -> | _ ->