@@ -41,11 +41,14 @@ import Data.Typeable (Typeable)
4141import Control.Arrow (first)
4242import Numeric (showHex)
4343
44−import Data.Enumerator (($$))
44+import Data.Enumerator (($$), Enumerator, enumList)
4545import qualified Data.Enumerator as E
46−import Data.Enumerator.IO (enumFile)
46+import Data.Enumerator.IO (iterHandle)
4747import Control.Monad.IO.Class (liftIO)
4848import Blaze.ByteString.Builder.Enumerator (builderToByteString)
49+import Blaze.ByteString.Builder (fromByteString, Builder, toLazyByteString)
50+import Blaze.ByteString.Builder.Char8 (fromChar)
51+import Data.Monoid (mconcat)
4952
5053run :: Port -> Application -> IO ()
5154run port = withSocketsDo .
@@ -152,48 +155,40 @@ parseFirst s = do
152155 let (rpath, qstring) = B.break (== '?') query
153156 return (method, rpath, qstring, hsecond)
154157
155−sendResponsePrelude :: Handle -> HttpVersion -> Status -> ResponseHeaders -> IO ()
156−sendResponsePrelude h httpversion status responseHeaders = do
157− B.hPut h $ B.pack "HTTP/"
158− B.hPut h $ httpversion
159− B.hPut h $ B.pack " "
160− B.hPut h $ B.pack $ show $ statusCode status
161− B.hPut h $ B.pack " "
162− B.hPut h $ statusMessage status
163− B.hPut h $ B.pack "\r\n"
164− mapM_ putHeader responseHeaders
165− B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n\r\n"
158+headers :: HttpVersion -> Status -> ResponseHeaders -> Builder
159+headers httpversion status responseHeaders = mconcat
160+ [ fromByteString "HTTP/"
161+ , fromByteString httpversion
162+ , fromChar ' '
163+ , fromByteString $ B.pack $ show $ statusCode status
164+ , fromChar ' '
165+ , fromByteString $ statusMessage status
166+ , fromByteString "\r\n"
167+ , mconcat $ map go responseHeaders
168+ , fromByteString "Transfer-Encoding: chunked\r\n\r\n"
169+ ]
166170 where
167− putHeader (x, y) = do
168− B.hPut h $ ciOriginal x
169− B.hPut h $ B.pack ": "
170− B.hPut h y
171− B.hPut h $ B.pack "\r\n"
171+ go (x, y) = mconcat
172+ [ fromByteString $ ciOriginal x
173+ , fromByteString ": "
174+ , fromByteString y
175+ , fromByteString "\r\n"
176+ ]
172177
173178sendResponse :: HttpVersion -> Handle -> Response -> IO ()
174−sendResponse httpversion h res = do
175− case res of
176− ResponseFile s hs fp -> do
177− sendResponsePrelude h httpversion s hs
178− E.run_ $ enumFile fp $$ myIter
179− ResponseLBS s hs lbs -> do
180− sendResponsePrelude h httpversion s hs
181− mapM_ myPut $ L.toChunks lbs
182− ResponseEnumerator enum -> enum myIter'
183− B.hPut h $ B.pack "0\r\n\r\n"
184− where
185− myIter' s hs = do
186− liftIO $ sendResponsePrelude h httpversion s hs
187− E.joinI $ builderToByteString $$ myIter
188− myIter = do
189− mbs <- E.head
190− case mbs of
191− Nothing -> return ()
192− Just bs -> liftIO (myPut bs) >> myIter
193− myPut bs = do
194− B.hPut h $ B.pack $ showHex (B.length bs) " \r\n"
195− B.hPut h bs
196− B.hPut h $ B.pack "\r\n"
179+sendResponse hv handle res = do
180+ responseEnumerator res $ \s hs -> do
181+ liftIO $ L.hPutStr handle $ toLazyByteString $ headers hv s hs
182+ i <- E.joinI $ builderToByteString $$ E.joinI $ chunk $$ iterHandle handle
183+ liftIO $ B.hPutStr handle "0\r\n\r\n"
184+ return i
185+ where
186+ chunk :: E.Enumeratee ByteString ByteString IO ()
187+ chunk = E.concatMap $ \bs ->
188+ [ B.pack $ showHex (B.length bs) " \r\n"
189+ , bs
190+ , "\r\n"
191+ ]
197192
198193parseHeaderNoAttr :: ByteString -> (ByteString, ByteString)
199194parseHeaderNoAttr s =