@@ -105,19 +105,17 @@ sendResponse :: Connection
105105sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
106106 restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
107107 where
108− rspidxhdr = indexResponseHeader hs0
109108 hs = addServer rspidxhdr $ addAcceptRanges hs0
109+ rspidxhdr = indexResponseHeader hs0
110110 th = threadHandle ii
111+
111112 sendResponseEither (Right (s, lengthyHeaders, beg, len))
112113 | hasBody s req = liftIO $ do
113114 lheader <- composeHeader version s lengthyHeaders
114115 connSendFile conn path beg len (T.tickle th) [lheader]
115116 T.tickle th
116117 return isPersist
117− | otherwise = liftIO $ do
118− composeHeader version s hs >>= connSendAll conn
119− T.tickle th
120− return isPersist -- FIXME isKeepAlive?
118+ | otherwise = liftIO $ sendResponseNoBody conn th version s hs isPersist
121119 where
122120 version = httpVersion req
123121 (isPersist,_) = infoFromRequest req reqidxhdr
@@ -140,13 +138,10 @@ sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs0 b)
140138 connSendAll conn bs
141139 T.tickle th
142140 return isKeepAlive
143− | otherwise = restore $ do
144− composeHeader version s hs >>= connSendAll conn
145− T.tickle th
146− return isPersist
141+ | otherwise = restore $ sendResponseNoBody conn th version s hs isPersist
147142 where
148− rspidxhdr = indexResponseHeader hs0
149143 hs = addServer rspidxhdr hs0
144+ rspidxhdr = indexResponseHeader hs0
150145 th = threadHandle ii
151146 version = httpVersion req
152147 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
@@ -160,14 +155,16 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs0 withBodyFlush)
160155 let src = CL.sourceList [header] `mappend` cbody bodyFlush
161156 src $$ builderToByteString =$ connSink conn th
162157 return isKeepAlive
163− | otherwise = withBodyFlush $ \_bodyFlush -> restore $ do -- make sure any cleanup is called
164− composeHeader version s hs >>= connSendAll conn
165− T.tickle th
166− return isPersist
158+ | otherwise = withBodyFlush $ \_bodyFlush ->
159+ -- make sure any cleanup is called
160+ restore $ sendResponseNoBody conn th version s hs isPersist
167161 where
168− rspidxhdr = indexResponseHeader hs0
169162 hs = addServer rspidxhdr hs0
163+ rspidxhdr = indexResponseHeader hs0
170164 th = threadHandle ii
165+ version = httpVersion req
166+ reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
167+ (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
171168 cbody bodyFlush = if needsChunked then body $= chunk else body
172169 where
173170 body = mapOutput (\x -> case x of
@@ -178,9 +175,16 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs0 withBodyFlush)
178175 -- functions below. Should lessen greatly the GC burden (I hope)
179176 chunk :: Conduit Builder IO Builder
180177 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
181− version = httpVersion req
182− reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
183− (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
178+
179+----------------------------------------------------------------
180+
181+sendResponseNoBody :: Connection -> T.Handle
182+ -> H.HttpVersion -> H.Status -> H.ResponseHeaders
183+ -> Bool -> IO Bool
184+sendResponseNoBody conn th version s hs isPersist = do
185+ composeHeader version s hs >>= connSendAll conn
186+ T.tickle th
187+ return isPersist
184188
185189----------------------------------------------------------------
186190----------------------------------------------------------------