@@ -28,8 +28,12 @@ import qualified Data.ByteString as S
28import qualified Data.ByteString.Char8 as B
28import qualified Data.ByteString.Char8 as B
29import qualified Data.ByteString.Lazy as L
29import qualified Data.ByteString.Lazy as L
30import Network
30import Network
31− ( listenOn, accept, sClose, PortID(PortNumber), Socket
31+ ( listenOn, sClose, PortID(PortNumber), Socket
32 , withSocketsDo)
32 , withSocketsDo)
36+import qualified Network.Socket.ByteString as Sock
33import Control.Exception (bracket, finally, Exception)
37import Control.Exception (bracket, finally, Exception)
34import System.IO (Handle, hClose, hFlush)
38import System.IO (Handle, hClose, hFlush)
35import System.IO.Error (isEOFError, ioeGetHandle)
39import System.IO.Error (isEOFError, ioeGetHandle)
@@ -50,7 +54,7 @@ import Blaze.ByteString.Builder.HTTP
50import Blaze.ByteString.Builder (fromByteString, Builder, toLazyByteString)
54import Blaze.ByteString.Builder (fromByteString, Builder, toLazyByteString)
51import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
55import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
52import Data.Monoid (mconcat)
56import Data.Monoid (mconcat)
53−import Network.Socket.SendFile (unsafeSendFile)
57+import Network.Socket.SendFile (sendFile)
55import Control.Monad.IO.Class (liftIO)
59import Control.Monad.IO.Class (liftIO)
@@ -64,35 +68,26 @@ type Port = Int
65serveConnections :: Port -> Application -> Socket -> IO ()
69serveConnections :: Port -> Application -> Socket -> IO ()
66serveConnections port app socket = do
70serveConnections port app socket = do
67− (conn, remoteHost', _) <- accept socket -- FIXME use sockets directly instead of Handlers?
71+ (conn, _) <- accept socket
68− -- FIXME disable buffering
72+ let remoteHost' = undefined
69 _ <- forkIO $ serveConnection port app conn remoteHost'
73 _ <- forkIO $ serveConnection port app conn remoteHost'
70 serveConnections port app socket
74 serveConnections port app socket
72−serveConnection :: Port -> Application -> Handle -> String -> IO ()
76+serveConnection :: Port -> Application -> Socket -> String -> IO ()
73serveConnection port app conn remoteHost' = do
77serveConnection port app conn remoteHost' = do
76 (E.run_ $ fromClient $$ serveConnection')
80 (E.run_ $ fromClient $$ serveConnection')
77− (hClose conn))
81+ (sClose conn))
78− catchEOFError
82+ undefined
80− fromClient = enumHandle 4096 conn
84+ fromClient = enumSocket 4096 conn
81 serveConnection' = do
85 serveConnection' = do
82 (enumeratee, env) <- parseRequest port remoteHost'
86 (enumeratee, env) <- parseRequest port remoteHost'
83 res <- E.joinI $ enumeratee $$ app env
87 res <- E.joinI $ enumeratee $$ app env
84 keepAlive <- liftIO $ sendResponse env (httpVersion env) conn res
88 keepAlive <- liftIO $ sendResponse env (httpVersion env) conn res
86 when keepAlive serveConnection'
89 when keepAlive serveConnection'
88− catchEOFError :: IOError -> IO ()
91− case ioeGetHandle e of
92− Just h -> unless (h == conn) (ioError e)
94− | otherwise = ioError e
96parseRequest :: Port -> String -> E.Iteratee S.ByteString IO (E.Enumeratee ByteString ByteString IO a, Request)
91parseRequest :: Port -> String -> E.Iteratee S.ByteString IO (E.Enumeratee ByteString ByteString IO a, Request)
97parseRequest port remoteHost' = do
92parseRequest port remoteHost' = do
98 headers' <- takeUntilBlank 0 id
93 headers' <- takeUntilBlank 0 id
@@ -222,20 +217,20 @@ isChunked = (==) http11
222hasBody :: Status -> Request -> Bool
217hasBody :: Status -> Request -> Bool
223hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
218hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
225−sendResponse :: Request -> HttpVersion -> Handle -> Response -> IO Bool
220+sendResponse :: Request -> HttpVersion -> Socket -> Response -> IO Bool
226−sendResponse req hv handle (ResponseFile s hs fp) = do
221+sendResponse req hv socket (ResponseFile s hs fp) = do
227− mapM_ (S.hPut handle) $ L.toChunks $ toLazyByteString $ headers hv s hs False
222+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
228 if hasBody s req
223 if hasBody s req
230− unsafeSendFile handle fp
225+ sendFile socket fp
231 return $ lookup "content-length" hs /= Nothing
226 return $ lookup "content-length" hs /= Nothing
232 else return True
227 else return True
233−sendResponse req hv handle (ResponseEnumerator res) =
228+sendResponse req hv socket (ResponseEnumerator res) =
237 | not (hasBody s req) = do
232 | not (hasBody s req) = do
238− liftIO $ mapM_ (S.hPut handle)
233+ liftIO $ Sock.sendMany socket
239 $ L.toChunks $ toLazyByteString
234 $ L.toChunks $ toLazyByteString
240 $ headers hv s hs False
235 $ headers hv s hs False
241 return True
236 return True
@@ -243,7 +238,7 @@ sendResponse req hv handle (ResponseEnumerator res) =
244 $ E.enumList 1 [headers hv s hs isChunked']
239 $ E.enumList 1 [headers hv s hs isChunked']
245 $$ E.joinI $ builderToByteString
240 $$ E.joinI $ builderToByteString
246− $$ (iterHandle handle >> return isKeepAlive)
241+ $$ (iterSocket socket >> return isKeepAlive)
248 hasLength = lookup "content-length" hs /= Nothing
243 hasLength = lookup "content-length" hs /= Nothing
249 isChunked' = isChunked hv && not hasLength
244 isChunked' = isChunked hv && not hasLength
@@ -298,3 +293,16 @@ requestBodyHandle initLen =
298 if newlen <= 0
293 if newlen <= 0
299 then return ()
294 then return ()
300 else drain newlen
295 else drain newlen
300+ go E.EOF = E.yield () E.EOF
301+ go (E.Chunks cs) = liftIO (Sock.sendMany socket cs) >> E.continue go
303+enumSocket len socket (E.Continue k) = do
304+ bs <- liftIO $ Sock.recv socket len
307+ else k (E.Chunks [bs]) >>== enumSocket len socket
308+enumSocket _ _ step = E.returnI step