From c57b070d876f4db6983467c2a53311a8ecb0691a Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Wed, 20 Nov 2024 12:42:06 +0100
Subject: [PATCH] add some Lwt.pause during Disk.check to allow the web server
 to process requests

---
 mirage/unikernel.ml | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml
index 3d62810..a5eb6e9 100644
--- a/mirage/unikernel.ml
+++ b/mirage/unikernel.ml
@@ -537,10 +537,17 @@ module Make
               | Some f ->
                 read_chunked t `SHA256 path
                   (fun (sha256, md5, sha512) data ->
-                     Lwt.return
-                       (SHA256.feed_string sha256 data,
-                        Option.map (fun t -> MD5.feed_string t data) md5,
-                        Option.map (fun t -> SHA512.feed_string t data) sha512))
+                     let sha256 = SHA256.feed_string sha256 data in
+                     Lwt.pause () >>= fun () ->
+                     let md5 =
+                       Option.map (fun t -> MD5.feed_string t data) md5
+                     in
+                     Lwt.pause () >>= fun () ->
+                     let sha512 =
+                       Option.map (fun t -> SHA512.feed_string t data) sha512
+                     in
+                     Lwt.pause () >|= fun () ->
+                     sha256, md5, sha512)
                   (SHA256.empty,
                    Option.map (fun _ -> MD5.empty) md5_final,
                    Option.map (fun _ -> SHA512.empty) sha512_final) >>= function