on master help sign in
Newer WAI
commitbe4b74d5c258c4476c1b7a0e38925724f0defea7 authorMichael Snoyman <michael@snoyman.com> dateThu 24 Mar 2011, 13:41 (16 years ago) parent44b5d84
2 files changed+21−22
Network/Wai/Handler/Warp.hs+17−14 warp.cabal+4−8
Network/Wai/Handler/Warp.hs+17−14
@@ -80,7 +80,7 @@ import Blaze.ByteString.Builder
8080 (copyByteString, Builder, toLazyByteString, toByteStringIO)
8181import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
8282import Data.Monoid (mappend, mconcat)
83−import Network.Socket.SendFile (sendFileIterWith, Iter (..))
83+import Network.Socket.SendFile (sendFileIterWith,sendFileIterWith', Iter (..))
8484
8585import Control.Monad.IO.Class (liftIO)
8686import qualified Timeout as T
@@ -88,7 +88,7 @@ import Data.Word (Word8)
8888import Data.List (foldl')
8989import Control.Monad (forever)
9090import qualified Network.HTTP.Types as H
91−import qualified Data.Ascii as A
91+import qualified Data.CaseInsensitive as CI
9292
9393#if WINDOWS
9494import Control.Concurrent (threadDelay)
@@ -151,7 +151,6 @@ serveConnections' set app socket = do
151151 tm <- T.initialize $ settingsTimeout set * 1000000
152152 forever $ do
153153 (conn, sa) <- accept socket
154− putStrLn "Accepted a connection"
155154 _ <- forkIO $ do
156155 th <- T.registerKillThread tm
157156 serveConnection th onE port app conn sa
@@ -217,17 +216,16 @@ parseRequest' port (firstLine:otherLines) remoteHost' = do
217216 then S.breakByte 47 $ S.drop 7 rpath' -- '/'
218217 else ("", rpath')
219218 let heads = map parseHeaderNoAttr otherLines
220− let host = A.toByteString $ fromMaybe (A.unsafeFromByteString host')
221− $ lookup "host" heads
219+ let host = fromMaybe host' $ lookup "host" heads
222220 let len =
223221 case lookup "content-length" heads of
224222 Nothing -> 0
225− Just bs -> fromIntegral $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit $ A.toByteString bs
223+ Just bs -> fromIntegral $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
226224 let serverName' = takeUntil 58 host -- ':'
227225 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a
228226 -- performance penalty, we may need our own version.
229227 return (EB.isolate len, Request
230− { requestMethod = A.unsafeFromByteString method
228+ { requestMethod = method
231229 , httpVersion = httpversion
232230 , pathInfo = H.decodePathSegments rpath
233231 , rawPathInfo = rpath
@@ -284,7 +282,7 @@ headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-
284282 `mappend` spaceBuilder
285283 `mappend` fromShow (H.statusCode status)
286284 `mappend` spaceBuilder
287− `mappend` copyByteString (A.toByteString $ H.statusMessage status)
285+ `mappend` copyByteString (H.statusMessage status)
288286 `mappend` newlineBuilder
289287 !start' = foldl' responseHeaderToBuilder start responseHeaders
290288 !end = if isChunked'
@@ -292,11 +290,11 @@ headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-
292290 else newlineBuilder
293291 in start' `mappend` end
294292
295−responseHeaderToBuilder :: Builder -> (A.CIAscii, A.Ascii) -> Builder
293+responseHeaderToBuilder :: Builder -> H.Header -> Builder
296294responseHeaderToBuilder b (x, y) = b
297− `mappend` (copyByteString $ A.ciToByteString x)
295+ `mappend` copyByteString (CI.original x)
298296 `mappend` colonSpaceBuilder
299− `mappend` copyByteString (A.toByteString y)
297+ `mappend` copyByteString y
300298 `mappend` newlineBuilder
301299
302300isChunked :: H.HttpVersion -> Bool
@@ -307,11 +305,16 @@ hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
307305
308306sendResponse :: T.Handle
309307 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
310−sendResponse th req hv socket (ResponseFile s hs fp) = do
308+sendResponse th req hv socket (ResponseFile s hs fp mpart) = do
311309 Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
312310 if hasBody s req
313311 then do
314− sendFileIterWith tickler socket fp sendFileCount
312+ case mpart of
313+ Nothing -> sendFileIterWith tickler socket fp sendFileCount
314+ Just part ->
315+ sendFileIterWith' tickler socket fp sendFileCount
316+ (filePartOffset part)
317+ (filePartByteCount part)
315318 return $ lookup "content-length" hs /= Nothing
316319 else return True
317320 where
@@ -382,7 +385,7 @@ parseHeaderNoAttr s =
382385 rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "
383386 then SU.unsafeDrop 2 rest
384387 else rest
385− in (A.toCIAscii $ A.unsafeFromByteString k, A.unsafeFromByteString rest')
388+ in (CI.mk k, rest')
386389
387390enumSocket :: T.Handle -> Int -> Socket -> E.Enumerator ByteString IO a
388391enumSocket th len socket =
warp.cabal+4−8
@@ -23,15 +23,11 @@ Library
2323 , blaze-builder-enumerator >= 0.2 && < 0.3
2424 , transformers >= 0.2 && < 0.3
2525 , enumerator >= 0.4.5 && < 0.5
26− , blaze-builder >= 0.2.1.4 && < 0.3
26+ , blaze-builder >= 0.2.1.4 && < 0.4
2727 , sendfile >= 0.7.2 && < 0.8
28− , http-types >= 0.5 && < 0.6
29− , ascii >= 0.0.2 && < 0.1
30− if flag(network-bytestring)
31− build-depends: network >= 2.2.1 && < 2.2.3
32− , network-bytestring >= 0.1.3 && < 0.1.4
33− else
34− build-depends: network >= 2.3 && < 2.4
28+ , http-types >= 0.6 && < 0.7
29+ , case-insensitive >= 0.2 && < 0.3
30+ , network >= 2.3 && < 2.4
3531 Exposed-modules: Network.Wai.Handler.Warp
3632 Other-modules: Timeout
3733 ghc-options: -Wall