@@ -17,7 +17,7 @@ import qualified Control.Concurrent as Conc (yield)
1717import Control.Exception as E
1818import qualified Data.ByteString as S
1919import Data.Char (chr)
20−import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')
20+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
2121import Data.Streaming.Network (bindPortTCP)
2222import Foreign.C.Error (Errno(..), eCONNABORTED)
2323import GHC.IO.Exception (IOException(..))
@@ -59,7 +59,11 @@ import Network.Socket (fdSocket)
5959
6060-- | Creating 'Connection' for plain HTTP based on a given socket.
6161socketConnection :: Settings -> Socket -> IO Connection
62+#if MIN_VERSION_network(3,1,1)
6263socketConnection set s = do
64+#else
65+socketConnection _ s = do
66+#endif
6367 bufferPool <- newBufferPool
6468 writeBuf <- allocateBuffer bufferSize
6569 let sendall = Sock.sendAll s
@@ -76,7 +80,7 @@ socketConnection set s = do
7680 if tm == 0 then
7781 close s
7882 else
79− gracefulClose s tm
83+ gracefulClose s tm `E.catch` \(E.SomeException _) -> return ()
8084#else
8185 , connClose = close s
8286#endif
@@ -282,10 +286,7 @@ fork :: Settings
282286fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
283287 -- Call the user-supplied on exception code if any
284288 -- exceptions are thrown.
285− handle (settingsOnException set Nothing) .
286− -- Allocate a new IORef indicating whether the connection has been
287− -- closed, to avoid double-freeing a connection
288− withClosedRef $ \ref ->
289+ handle (settingsOnException set Nothing) $
289290 -- Run the connection maker to get a new connection, and ensure
290291 -- that the connection is closed. If the mkConn call throws an
291292 -- exception, we will leak the connection. If the mkConn call is
@@ -296,21 +297,13 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
296297 -- We grab the connection before registering timeouts since the
297298 -- timeouts will be useless during connection creation, due to the
298299 -- fact that async exceptions are still masked.
299− bracket mkConn (cleanUp ref) (serve unmask ref)
300+ bracket mkConn cleanUp (serve unmask)
300301 where
301− withClosedRef inner = newIORef False >>= inner
302−
303− closeConn ref conn = do
304− isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
305− unless isClosed $ connClose conn
306−
307− cleanUp ref (conn, _) = closeConn ref conn `finally` connFree conn
302+ cleanUp (conn, _) = connClose conn `finally` connFree conn
308303
309304 -- We need to register a timeout handler for this thread, and
310− -- cancel that handler as soon as we exit. We additionally close
311− -- the connection immediately in case the child thread catches the
312− -- async exception or performs some long-running cleanup action.
313− serve unmask ref (conn, transport) = bracket register cancel $ \th -> do
305+ -- cancel that handler as soon as we exit.
306+ serve unmask (conn, transport) = bracket register cancel $ \th -> do
314307 -- We now have fully registered a connection close handler in
315308 -- the case of all exceptions, so it is safe to once again
316309 -- allow async exceptions.
@@ -322,8 +315,7 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
322315 -- above ensures the connection is closed.
323316 when goingon $ serveConnection conn ii th addr transport set app
324317 where
325− register = T.registerKillThread (timeoutManager ii)
326− (closeConn ref conn)
318+ register = T.registerKillThread (timeoutManager ii) (connClose conn)
327319 cancel = T.cancel
328320
329321 onOpen adr = increase counter >> settingsOnOpen set adr
@@ -350,11 +342,19 @@ serveConnection conn ii th origAddr transport settings app = do
350342 istatus <- newIORef False
351343 if settingsHTTP2Enabled settings && h2 then do
352344 rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
345+ -- This thread becomes the sender in http2 library.
346+ -- In the case of event source, one request comes and one
347+ -- worker gets busy. But it is likely that the receiver does
348+ -- not receive any data at all while the sender is sending
349+ -- output data from the worker. It's not good enough to tickle
350+ -- the time handler in the receiver only. So, we should tickle
351+ -- the time handler in both the receiver and the sender.
353352 let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN
353+ sendBS x = connSendAll conn x >> T.tickle th
354354 -- fixme: origAddr
355355 checkTLS
356356 setConnHTTP2 conn True
357− http2 conn transport ii origAddr settings recvN app
357+ http2 conn transport ii origAddr settings recvN sendBS app
358358 else do
359359 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
360360 writeIORef istatus True