From e4317551c99a80f9cf5bf3e9e6b8f771fe6538cf Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 17 Aug 2026 07:38:16 +0900
Subject: [PATCH 1/2] `gracefulClose` continues `readBuf` until EOF is reached,
 as much as possible.

trying to fix https://github.com/haskell/network/issues/618
---
 Network/Socket/Shutdown.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs
index 0e13b9a6..702eb0dc 100644
--- a/Network/Socket/Shutdown.hs
+++ b/Network/Socket/Shutdown.hs
@@ -73,5 +73,16 @@ gracefulClose s tmout0 =
 bufSize :: Int
 bufSize = 1024
 
+-- Maximum number of bytes to drain while waiting for the peer's FIN.
+drainLimit :: Int
+drainLimit = 128 * 1024
+
 recvEOFtimeout :: Socket -> Int -> Ptr Word8 -> IO ()
-recvEOFtimeout s tmout0 buf = void $ timeout (tmout0 * 1000) $ recvBuf s buf bufSize
+recvEOFtimeout s tmout0 buf =
+    void $ timeout (tmout0 * 1000) $ loop 0
+  where
+    loop n0 = do
+        n1 <- recvBuf s buf bufSize
+        when (n1 > 0) $ do
+            let n = n0 + n1
+            when (n < drainLimit) $ loop n

From 666bf5b63c05624663e98179300ffbdc2368b9f2 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 17 Aug 2026 07:39:54 +0900
Subject: [PATCH 2/2] Ensuring the server does not exceed the time limit in the
 gracefulClose test.

---
 tests/Network/SocketSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs
index cf78c9d7..e3142081 100644
--- a/tests/Network/SocketSpec.hs
+++ b/tests/Network/SocketSpec.hs
@@ -254,7 +254,7 @@ spec = do
         it "does not send TCP RST back" $ do
             let server sock = do
                     void $ recv sock 1024 -- receiving "GOAWAY"
-                    gracefulClose sock 3000
+                    gracefulClose sock 300
                 client sock = do
                     sendAll sock "GOAWAY"
                     threadDelay 10000