681935f · typeable/wai

git.iko.soy/typeable/wai

Update warp for .Internal module

commit681935f3ab1c725016df421c6f5bade13a0cb0ca authorMichael Snoyman <michael@snoyman.com> dateMon 19 Aug 2013, 11:03 (13 years ago) parent9ad8c89

4 files changed+17−23

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Request.hs+10−16 warp/Network/Wai/Handler/Warp/Response.hs+1 warp/Network/Wai/Handler/Warp/Run.hs+4−5 warp/test/PartialFileSpec.hs+2−2

warp/Network/Wai/Handler/Warp/Request.hs+10−16

@@ -14,13 +14,12 @@ import qualified Data.ByteString.Unsafe as SU

1414import qualified Data.CaseInsensitive as CI

1515import Data.Conduit

1616import qualified Data.IORef as I

17−import Data.Maybe (fromMaybe)

1817import Data.Monoid (mempty)

19−import Data.Void (Void)

2018import Data.Word (Word8)

2119import qualified Network.HTTP.Types as H

2220import Network.Socket (SockAddr)

2321import Network.Wai

22+import Network.Wai.Internal

2423import Network.Wai.Handler.Warp.Conduit

2524import Network.Wai.Handler.Warp.ReadInt

2625import Network.Wai.Handler.Warp.Types

@@ -36,12 +35,12 @@ parseRequest

3635 :: Connection

3736 -> Timeout.Handle

3837 -> Res.InternalState

39− -> Port -> SockAddr

38+ -> SockAddr

4039 -> Source IO ByteString

4140 -> IO (Request, IO (ResumableSource IO ByteString))

42−parseRequest conn timeoutHandle internalState port remoteHost' src1 = do

41+parseRequest conn timeoutHandle internalState remoteHost' src1 = do

4342 (src2, headers') <- src1 $$+ takeHeaders

44− parseRequest' conn timeoutHandle internalState port headers' remoteHost' src2

43+ parseRequest' conn timeoutHandle internalState headers' remoteHost' src2

4544

4645handleExpect :: Connection

4746 -> H.HttpVersion

@@ -61,27 +60,24 @@ handleExpect conn hv front (x:xs) = handleExpect conn hv (front . (x:)) xs

6160parseRequest' :: Connection

6261 -> Timeout.Handle

6362 -> Res.InternalState

64− -> Port

6563 -> [ByteString]

6664 -> SockAddr

6765 -> ResumableSource IO ByteString -- FIXME was buffered

6866 -> IO (Request, IO (ResumableSource IO ByteString))

69−parseRequest' _ _ _ _ [] _ _ = throwIO $ NotEnoughLines []

70−parseRequest' conn timeoutHandle internalState port (firstLine:otherLines) remoteHost' src = do

67+parseRequest' _ _ _ [] _ _ = throwIO $ NotEnoughLines []

68+parseRequest' conn timeoutHandle internalState (firstLine:otherLines) remoteHost' src = do

7169 (method, rpath', gets, httpversion) <- parseFirst firstLine

72− let (host',rpath)

73− | S.null rpath' = ("", "/")

74− | "http://" `S.isPrefixOf` rpath' = S.breakByte 47 $ S.drop 7 rpath'

75− | otherwise = ("", rpath')

70+ let rpath

71+ | S.null rpath' = "/"

72+ | "http://" `S.isPrefixOf` rpath' = snd $ S.breakByte 47 $ S.drop 7 rpath'

73+ | otherwise = rpath'

7674 heads <- liftIO

7775 $ handleExpect conn httpversion id

7876 (map parseHeaderNoAttr otherLines)

79− let host = fromMaybe host' $ lookup hHost heads

8077 let len0 =

8178 case lookup H.hContentLength heads of

8279 Nothing -> 0

8380 Just bs -> readInt bs

84− let serverName' = takeUntil 58 host -- ':'

8581 let chunked = maybe False ((== "chunked") . CI.foldCase)

8682 $ lookup hTransferEncoding heads

8783 (rbody, getSource) <-

@@ -100,8 +96,6 @@ parseRequest' conn timeoutHandle internalState port (firstLine:otherLines) remot

10096 , rawPathInfo = rpath

10197 , rawQueryString = gets

10298 , queryString = H.parseQuery gets

103− , serverName = serverName'

104− , serverPort = port

10599 , requestHeaders = heads

106100 , isSecure = False

107101 , remoteHost = remoteHost'

warp/Network/Wai/Handler/Warp/Response.hs+1

@@ -21,6 +21,7 @@ import Data.Maybe (isJust, listToMaybe)

2121import Data.Monoid (mappend)

2222import qualified Network.HTTP.Types as H

2323import Network.Wai

24+import Network.Wai.Internal

2425import Network.Wai.Handler.Warp.ReadInt

2526import Network.Wai.Handler.Warp.Settings

2627import qualified Network.Wai.Handler.Warp.ResponseHeader as RH

warp/Network/Wai/Handler/Warp/Run.hs+4−5

@@ -206,7 +206,7 @@ runSettingsConnectionMaker set getConn app = do

206206 bracket_ onOpen onClose $

207207

208208 -- Actually serve this connection.

209− serveConnection th set cleaner port app conn addr

209+ serveConnection th set cleaner app conn addr

210210 where

211211 -- FIXME: only IOEception is caught. What about other exceptions?

212212 getConnLoop = getConn `catch` \(e :: IOException) -> do

@@ -216,7 +216,6 @@ runSettingsConnectionMaker set getConn app = do

216216 threadDelay 1000000

217217 getConnLoop

218218 onE = settingsOnException set

219− port = settingsPort set

220219 onOpen = settingsOnOpen set

221220 onClose = settingsOnClose set

222221

@@ -231,8 +230,8 @@ runSettingsConnectionMaker set getConn app = do

231230serveConnection :: T.Handle

232231 -> Settings

233232 -> Cleaner

234− -> Port -> Application -> Connection -> SockAddr-> IO ()

235−serveConnection timeoutHandle settings cleaner port app conn remoteHost' =

233+ -> Application -> Connection -> SockAddr-> IO ()

234+serveConnection timeoutHandle settings cleaner app conn remoteHost' =

236235 runResourceT $ Res.withInternalState $ serveConnection'' $ connSource conn th

237236 where

238237 innerRunResourceT env f

@@ -243,7 +242,7 @@ serveConnection timeoutHandle settings cleaner port app conn remoteHost' =

243242 th = threadHandle cleaner

244243

245244 serveConnection'' fromClient internalState = do

246− (env, getSource) <- parseRequest conn timeoutHandle internalState port remoteHost' fromClient

245+ (env, getSource) <- parseRequest conn timeoutHandle internalState remoteHost' fromClient

247246 case settingsIntercept settings env of

248247 Nothing -> do

249248 -- Let the application run for as long as it wants

warp/test/PartialFileSpec.hs+2−2

@@ -40,7 +40,7 @@ testRange range out crange = it title $ withApp defaultSettings app $ \port -> d

4040 lookup "Content-Range" hs `shouldBe` Just ("bytes " ++ crange)

4141 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)

4242 where

43− app _ = return $ ResponseFile status200 [] "attic/hex" Nothing

43+ app _ = return $ responseFile status200 [] "attic/hex" Nothing

4444 title = show (range, out, crange)

4545 toHeader s =

4646 case break (== ':') s of

@@ -62,7 +62,7 @@ testPartial offset count out = it title $ withApp defaultSettings app $ \port ->

6262 let hs = mapMaybe toHeader bss

6363 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)

6464 where

65− app _ = return $ ResponseFile status200 [] "attic/hex" $ Just $ FilePart offset count

65+ app _ = return $ responseFile status200 [] "attic/hex" $ Just $ FilePart offset count

6666 title = show (offset, count, out)

6767 toHeader s =

6868 case break (== ':') s of