c82e85d · typeable/wai

git.iko.soy/typeable/wai

Merge remote-tracking branch 'origin/master'

commitc82e85de578800342779f974aa95d164e3a91e12 authorMichael Snoyman <michael@snoyman.com> dateWed 8 Feb 2012, 10:18 (15 years ago) parent05198ce e7c9d7d

4 files changed+30−48

compare with master

unifiedsplit

wai-app-static/test/WaiAppStaticTest.hs+1−20 wai-test/Network/Wai/Test.hs+8 wai-test/wai-test.cabal+1 warp/Network/Wai/Handler/Warp.hs+20−28

wai-app-static/test/WaiAppStaticTest.hs+1−20

@@ -27,26 +27,7 @@ import Control.Monad.IO.Class (liftIO)

2727import Data.Monoid (mempty)

2828

2929defRequest :: Request

30−defRequest = Request {

31− rawQueryString = ""

32−, queryString = []

33−, requestMethod = "GET"

34−, rawPathInfo = ""

35−, pathInfo = []

36−, requestHeaders = []

37−, serverName = "wai-test"

38−, httpVersion = H.http11

39−, serverPort = 80

40−, isSecure = False

41−, remoteHost = Sock.SockAddrInet 1 2

42−, vault = mempty

43−, requestBody = error "requestBody"

44−}

45−

46−setRawPathInfo :: Request -> S8.ByteString -> Request

47−setRawPathInfo r rawPinfo =

48− let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo

49− in r { rawPathInfo = rawPinfo, pathInfo = pInfo }

30+defRequest = defaultRequest

5031

5132specs :: Specs

5233specs = do

wai-test/Network/Wai/Test.hs+8

@@ -9,6 +9,7 @@ module Network.Wai.Test

99 , SRequest (..)

1010 , SResponse (..)

1111 , defaultRequest

12+ , setRawPathInfo

1213 -- * Assertions

1314 , assertStatus

1415 , assertContentType

@@ -33,6 +34,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8

3334import qualified Network.HTTP.Types as H

3435import Data.CaseInsensitive (CI)

3536import qualified Data.ByteString as S

37+import qualified Data.Text as T

38+import qualified Data.Text.Encoding as TE

3639import qualified Data.Conduit as C

3740import qualified Data.Conduit.List as CL

3841import Data.Monoid (mempty)

@@ -79,6 +82,11 @@ defaultRequest = Request

7982 , vault = mempty

8083 }

8184

85+setRawPathInfo :: Request -> S8.ByteString -> Request

86+setRawPathInfo r rawPinfo =

87+ let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo

88+ in r { rawPathInfo = rawPinfo, pathInfo = pInfo }

89+

8290srequest :: SRequest -> Session SResponse

8391srequest (SRequest req bod) = do

8492 app <- ask

wai-test/wai-test.cabal+1

@@ -16,6 +16,7 @@ library

1616 build-depends: base >= 4 && < 5

1717 , wai >= 1.1 && < 1.2

1818 , bytestring >= 0.9.1.4 && < 0.10

19+ , text >= 0.7 && < 0.12

1920 , blaze-builder >= 0.2.1.4 && < 0.4

2021 , transformers >= 0.2.2 && < 0.3

2122 , containers >= 0.2 && < 0.5

warp/Network/Wai/Handler/Warp.hs+20−28

@@ -115,7 +115,7 @@ import Data.List (foldl')

115115import Control.Monad (forever, when)

116116import qualified Network.HTTP.Types as H

117117import qualified Data.CaseInsensitive as CI

118−import System.IO (hPutStrLn, stderr)

118+import System.IO (hPrint, stderr)

119119import ReadInt (readInt64)

120120import qualified Data.IORef as I

121121import Data.String (IsString (..))

@@ -198,7 +198,7 @@ bindPort p s = do

198198 theBody addr =

199199 bracketOnError

200200 (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))

201− (sClose)

201+ sClose

202202 (\sock -> do

203203 setSocketOption sock ReuseAddr 1

204204 bindSocket sock (addrAddress addr)

@@ -511,6 +511,7 @@ sendResponse th req conn r = sendResponse' r

511511 needsChunked hs = isChunked' && not (hasLength hs)

512512 isKeepAlive hs = isPersist && (isChunked' || hasLength hs)

513513 hasLength hs = isJust $ lookup "content-length" hs

514+ sendHeader = connSendMany conn . L.toChunks . toLazyByteString

514515

515516 sendResponse' :: Response -> ResourceT IO Bool

516517 sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do

@@ -523,17 +524,17 @@ sendResponse th req conn r = sendResponse' r

523524 (Nothing, Just part) -> do

524525 let cl = filePartByteCount part

525526 return $ addClToHeaders cl

526− connSendMany conn $ L.toChunks $ toLazyByteString $

527− headers version s lengthyHeaders False

528−

527+ let headers' = headers version s lengthyHeaders

528+ sendHeader $ headers' False

529529 T.tickle th

530−

531− if not (hasBody s req) then return isPersist else do

530+ if hasBody s req then do

532531 case mpart of

533532 Nothing -> connSendFile conn fp 0 cl (T.tickle th)

534533 Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)

535534 T.tickle th

536535 return isPersist

536+ else

537+ return isPersist

537538 where

538539 addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)

539540

@@ -544,10 +545,7 @@ sendResponse th req conn r = sendResponse' r

544545 T.tickle th) body

545546 return (isKeepAlive hs)

546547 | otherwise = liftIO $ do

547− connSendMany conn

548− $ L.toChunks

549− $ toLazyByteString

550− $ headers' False

548+ sendHeader $ headers' False

551549 T.tickle th

552550 return isPersist

553551 where

@@ -559,8 +557,16 @@ sendResponse th req conn r = sendResponse' r

559557 `mappend` chunkedTransferTerminator

560558 else headers' False `mappend` b

561559

562− sendResponse' (ResponseSource s hs bodyFlush) =

563− response

560+ sendResponse' (ResponseSource s hs bodyFlush)

561+ | hasBody s req = do

562+ let src = CL.sourceList [headers' needsChunked'] `mappend`

563+ (if needsChunked' then body C.$= chunk else body)

564+ src C.$$ builderToByteString C.=$ connSink conn th

565+ return $ isKeepAlive hs

566+ | otherwise = liftIO $ do

567+ sendHeader $ headers' False

568+ T.tickle th

569+ return isPersist

564570 where

565571 body = fmap (\x -> case x of

566572 C.Flush -> flush

@@ -568,26 +574,12 @@ sendResponse th req conn r = sendResponse' r

568574 headers' = headers version s hs

569575 -- FIXME perhaps alloca a buffer per thread and reuse that in all

570576 -- functions below. Should lessen greatly the GC burden (I hope)

571− response

572− | not (hasBody s req) = liftIO $ do

573− connSendMany conn

574− $ L.toChunks $ toLazyByteString

575− $ headers' False

576− T.tickle th

577− return (checkPersist req)

578− | otherwise = do

579− let src =

580− CL.sourceList [headers' needsChunked'] `mappend`

581− (if needsChunked' then body C.$= chunk else body)

582− src C.$$ builderToByteString C.=$ connSink conn th

583− return $ isKeepAlive hs

584577 needsChunked' = needsChunked hs

585578 chunk :: C.Conduit Builder IO Builder

586579 chunk = C.Conduit

587580 { C.conduitPush = push

588581 , C.conduitClose = close

589582 }

590−

591583 conduit = C.Conduit push close

592584 push x = return $ C.Producing conduit [chunkedTransferEncoding x]

593585 close = return [chunkedTransferTerminator]

@@ -695,7 +687,7 @@ defaultSettings = Settings

695687 Just x -> go x

696688 Nothing ->

697689 when (go' $ fromException e) $

698− hPutStrLn stderr $ show e

690+ hPrint stderr e

699691 , settingsTimeout = 30

700692 , settingsIntercept = const Nothing

701693 , settingsManager = Nothing