be4b74d · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Newer WAI

be4b74dMichael Snoyman16 years ago

Network/Wai/Handler/Warp.hs+17−14

compare with master

unifiedsplit

@@ -80,7 +80,7 @@ import Blaze.ByteString.Builder

80 (copyByteString, Builder, toLazyByteString, toByteStringIO)

81import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)

82import Data.Monoid (mappend, mconcat)

83−import Network.Socket.SendFile (sendFileIterWith, Iter (..))

83+import Network.Socket.SendFile (sendFileIterWith,sendFileIterWith', Iter (..))

85import Control.Monad.IO.Class (liftIO)

86import qualified Timeout as T

@@ -88,7 +88,7 @@ import Data.Word (Word8)

88import Data.List (foldl')

89import Control.Monad (forever)

90import qualified Network.HTTP.Types as H

91−import qualified Data.Ascii as A

91+import qualified Data.CaseInsensitive as CI

93#if WINDOWS

94import Control.Concurrent (threadDelay)

@@ -151,7 +151,6 @@ serveConnections' set app socket = do

151 tm <- T.initialize $ settingsTimeout set * 1000000

152 forever $ do

153 (conn, sa) <- accept socket

154− putStrLn "Accepted a connection"

155 _ <- forkIO $ do

154 _ <- forkIO $ do

156 th <- T.registerKillThread tm

155 th <- T.registerKillThread tm

157 serveConnection th onE port app conn sa

156 serveConnection th onE port app conn sa

@@ -217,17 +216,16 @@ parseRequest' port (firstLine:otherLines) remoteHost' = do

217 then S.breakByte 47 $ S.drop 7 rpath' -- '/'

216 then S.breakByte 47 $ S.drop 7 rpath' -- '/'

218 else ("", rpath')

217 else ("", rpath')

219 let heads = map parseHeaderNoAttr otherLines

218 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

222 let len =

220 let len =

223 case lookup "content-length" heads of

221 case lookup "content-length" heads of

224 Nothing -> 0

222 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

226 let serverName' = takeUntil 58 host -- ':'

224 let serverName' = takeUntil 58 host -- ':'

227 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a

225 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a

228 -- performance penalty, we may need our own version.

226 -- performance penalty, we may need our own version.

229 return (EB.isolate len, Request

227 return (EB.isolate len, Request

230− { requestMethod = A.unsafeFromByteString method

228+ { requestMethod = method

231 , httpVersion = httpversion

229 , httpVersion = httpversion

232 , pathInfo = H.decodePathSegments rpath

230 , pathInfo = H.decodePathSegments rpath

233 , rawPathInfo = rpath

231 , rawPathInfo = rpath

@@ -284,7 +282,7 @@ headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-

284 `mappend` spaceBuilder

282 `mappend` spaceBuilder

285 `mappend` fromShow (H.statusCode status)

283 `mappend` fromShow (H.statusCode status)

286 `mappend` spaceBuilder

284 `mappend` spaceBuilder

287− `mappend` copyByteString (A.toByteString $ H.statusMessage status)

285+ `mappend` copyByteString (H.statusMessage status)

288 `mappend` newlineBuilder

286 `mappend` newlineBuilder

289 !start' = foldl' responseHeaderToBuilder start responseHeaders

287 !start' = foldl' responseHeaderToBuilder start responseHeaders

290 !end = if isChunked'

288 !end = if isChunked'

@@ -292,11 +290,11 @@ headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-

292 else newlineBuilder

290 else newlineBuilder

293 in start' `mappend` end

291 in start' `mappend` end

294

292

295−responseHeaderToBuilder :: Builder -> (A.CIAscii, A.Ascii) -> Builder

293+responseHeaderToBuilder :: Builder -> H.Header -> Builder

296responseHeaderToBuilder b (x, y) = b

294responseHeaderToBuilder b (x, y) = b

297− `mappend` (copyByteString $ A.ciToByteString x)

295+ `mappend` copyByteString (CI.original x)

298 `mappend` colonSpaceBuilder

296 `mappend` colonSpaceBuilder

299− `mappend` copyByteString (A.toByteString y)

297+ `mappend` copyByteString y

300 `mappend` newlineBuilder

298 `mappend` newlineBuilder

301

299

302isChunked :: H.HttpVersion -> Bool

300isChunked :: H.HttpVersion -> Bool

@@ -307,11 +305,16 @@ hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"

307

305

308sendResponse :: T.Handle

306sendResponse :: T.Handle

309 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool

307 -> 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

311 Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False

309 Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False

312 if hasBody s req

310 if hasBody s req

313 then do

311 then do

312+ case mpart of

313+ Nothing -> sendFileIterWith tickler socket fp sendFileCount

314+ Just part ->

314− sendFileIterWith tickler socket fp sendFileCount

315+ sendFileIterWith' tickler socket fp sendFileCount

316+ (filePartOffset part)

317+ (filePartByteCount part)

315 return $ lookup "content-length" hs /= Nothing

318 return $ lookup "content-length" hs /= Nothing

316 else return True

319 else return True

317 where

320 where

@@ -382,7 +385,7 @@ parseHeaderNoAttr s =

382 rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "

385 rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "

383 then SU.unsafeDrop 2 rest

386 then SU.unsafeDrop 2 rest

384 else rest

387 else rest

385− in (A.toCIAscii $ A.unsafeFromByteString k, A.unsafeFromByteString rest')

388+ in (CI.mk k, rest')

386

389

387enumSocket :: T.Handle -> Int -> Socket -> E.Enumerator ByteString IO a

390enumSocket :: T.Handle -> Int -> Socket -> E.Enumerator ByteString IO a

388enumSocket th len socket =

391enumSocket th len socket =

warp.cabal+4−8

@@ -23,15 +23,11 @@ Library

23 , blaze-builder-enumerator >= 0.2 && < 0.3

24 , transformers >= 0.2 && < 0.3

25 , enumerator >= 0.4.5 && < 0.5

26− , blaze-builder >= 0.2.1.4 && < 0.3

26+ , blaze-builder >= 0.2.1.4 && < 0.4

27 , sendfile >= 0.7.2 && < 0.8

28− , http-types >= 0.5 && < 0.6

28+ , http-types >= 0.6 && < 0.7

29− , ascii >= 0.0.2 && < 0.1

29+ , case-insensitive >= 0.2 && < 0.3

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

30+ , network >= 2.3 && < 2.4

35 Exposed-modules: Network.Wai.Handler.Warp

31 Exposed-modules: Network.Wai.Handler.Warp

36 Other-modules: Timeout

32 Other-modules: Timeout

37 ghc-options: -Wall

33 ghc-options: -Wall