@@ -27,7 +27,7 @@ import Network
2727 ( listenOn, accept, sClose, PortID(PortNumber), Socket
2828 , withSocketsDo)
2929import Control.Exception (bracket, finally, Exception)
30−import System.IO (Handle, hClose)
30+import System.IO (Handle, hClose, hFlush)
3131import Control.Concurrent (forkIO)
3232import Control.Monad (unless)
3333import Data.Maybe (isJust, fromJust, fromMaybe)
@@ -62,10 +62,36 @@ serveConnection port app conn remoteHost' =
6262 serveConnection'
6363 (hClose conn)
6464 where
65− serveConnection' = do
66− env <- hParseRequest port conn remoteHost'
67− res <- app env
68− sendResponse conn res
65+ serveConnection' = do
66+ disconnect <- serveOneRequest'
67+ hFlush conn
68+ case disconnect of
69+ False -> serveConnection'
70+ True -> return ()
71+
72+ serveOneRequest' = do
73+ env <- hParseRequest port conn remoteHost'
74+ res <- app env
75+ sendResponse conn res
76+ return $ shouldConnectionClose env res
77+
78+reqConnectionHeader :: RequestHeader
79+reqConnectionHeader = RequestHeader $ B8.pack "Connection"
80+
81+resConnectionHeader :: ResponseHeader
82+resConnectionHeader = ResponseHeader $ B8.pack "Connection"
83+
84+shouldConnectionClose :: Request -> Response -> Bool
85+shouldConnectionClose req res = (isClose req_conn)
86+ || (isClose res_conn)
87+
88+ where
89+ isClose v = case v of
90+ Just x -> (B8.unpack x) == "close"
91+ Nothing -> False
92+
93+ req_conn = lookup reqConnectionHeader $ requestHeaders req
94+ res_conn = lookup resConnectionHeader $ responseHeaders res
6995
7096hParseRequest :: Port -> Handle -> String -> IO Request
7197hParseRequest port conn remoteHost' = do