ad8eafc · typeable/wai

package-list.sh+3−2

@@ -1,6 +1,6 @@

11#!/bin/bash

22

3−pkgs=( ./wai

3+pkgs=( ./wai

44 ./wai-test

55 ./wai-extra

66 ./warp

@@ -9,4 +9,5 @@ pkgs=( ./wai

99 ./wai-handler-launch

1010 ./wai-handler-scgi

1111 ./warp-static

12− ./wai-websockets )

12+ )

13+ # ./wai-websockets

wai-app-static/wai-app-static.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-app-static

2−version: 0.3.5.1

2+version: 1.0.0

33license: BSD3

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -24,7 +24,7 @@ Flag print

2424

2525library

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

27− , wai >= 0.4 && < 0.5

27+ , wai >= 1.0 && < 1.1

2828 , bytestring >= 0.9.1.4 && < 0.10

2929 , http-types >= 0.6 && < 0.7

3030 , transformers >= 0.2.2 && < 0.3

@@ -59,7 +59,7 @@ test-suite runtests

5959 , time >= 1.1.4

6060 , old-locale >= 1.0.0.2 && < 1.1

6161 , http-date

62− , wai-app-static >= 0.3

62+ , wai-app-static >= 1.0

6363 , wai-test

6464 , wai

6565 , http-types

wai-extra/Network/Wai/Handler/CGI.hs+49−48

@@ -19,20 +19,19 @@ import Control.Arrow ((***))

1919import Data.Char (toLower)

2020import qualified System.IO

2121import qualified Data.String as String

22−import Data.Enumerator

23− ( Enumerator, Step (..), Stream (..), continue, yield

24− , enumList, ($$), joinI, returnI, (>>==), run_

25− )

2622import Data.Monoid (mconcat)

2723import Blaze.ByteString.Builder (fromByteString, toLazyByteString)

2824import Blaze.ByteString.Builder.Char8 (fromChar, fromString)

29−import Blaze.ByteString.Builder.Enumerator (builderToByteString)

25+import Data.Conduit.Blaze (builderToByteString)

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

3127import Data.ByteString.Lazy.Internal (defaultChunkSize)

3228import System.IO (Handle)

3329import Network.HTTP.Types (Status (..))

3430import qualified Network.HTTP.Types as H

3531import qualified Data.CaseInsensitive as CI

32+import Data.Monoid (mappend)

33+import qualified Data.Conduit as C

34+import qualified Data.Conduit.List as CL

3635

3736safeRead :: Read a => a -> String -> a

3837safeRead d s =

@@ -67,7 +66,7 @@ runSendfile sf app = do

6766-- stick with 'run' or 'runSendfile'.

6867runGeneric

6968 :: [(String, String)] -- ^ all variables

70− -> (forall a. Int -> Enumerator B.ByteString IO a) -- ^ responseBody of input

69+ -> (Int -> C.Source IO B.ByteString) -- ^ responseBody of input

7170 -> (B.ByteString -> IO ()) -- ^ destination for output

7271 -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?

7372 -> Application

@@ -95,26 +94,32 @@ runGeneric vars inputH outputH xsendfile app = do

9594 case addrs of

9695 a:_ -> addrAddress a

9796 [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'

98− let env = Request

99− { requestMethod = rmethod

100− , rawPathInfo = B.pack pinfo

101− , pathInfo = H.decodePathSegments $ B.pack pinfo

102− , rawQueryString = B.pack qstring

103− , queryString = H.parseQuery $ B.pack qstring

104− , serverName = B.pack servername

105− , serverPort = serverport

106− , requestHeaders = map (cleanupVarName *** B.pack) vars

107− , isSecure = isSecure'

108− , remoteHost = addr

109− , httpVersion = H.http11 -- FIXME

110− }

111− -- FIXME worry about exception?

112− res <- run_ $ inputH contentLength $$ app env

113− case (xsendfile, res) of

114− (Just sf, ResponseFile s hs fp Nothing) ->

115− mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp

116− _ -> responseEnumerator res $ \s hs ->

117− joinI $ enumList 1 [headers s hs, fromChar '\n'] $$ builderIter

97+ C.runResourceT $ do

98+ input <- C.bufferSource $ inputH contentLength

99+ let env = Request

100+ { requestMethod = rmethod

101+ , rawPathInfo = B.pack pinfo

102+ , pathInfo = H.decodePathSegments $ B.pack pinfo

103+ , rawQueryString = B.pack qstring

104+ , queryString = H.parseQuery $ B.pack qstring

105+ , serverName = B.pack servername

106+ , serverPort = serverport

107+ , requestHeaders = map (cleanupVarName *** B.pack) vars

108+ , isSecure = isSecure'

109+ , remoteHost = addr

110+ , httpVersion = H.http11 -- FIXME

111+ , requestBody = input

112+ }

113+ -- FIXME worry about exception?

114+ res <- app env

115+ case (xsendfile, res) of

116+ (Just sf, ResponseFile s hs fp Nothing) ->

117+ liftIO $ mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp

118+ _ -> do

119+ let (s, hs, b) = responseSource res

120+ src = CL.sourceList [headers s hs `mappend` fromChar '\n']

121+ `mappend` b

122+ src C.$$ builderSink

118123 where

119124 headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))

120125 status (Status i m) = (fromByteString "Status", mconcat

@@ -136,11 +141,11 @@ runGeneric vars inputH outputH xsendfile app = do

136141 , fromByteString sf

137142 , fromByteString " not supported"

138143 ]

139− bsStep = Continue bsStep'

140− bsStep' EOF = yield () EOF

141− bsStep' (Chunks []) = continue bsStep'

142− bsStep' (Chunks bss) = liftIO (mapM_ outputH bss) >> continue bsStep'

143− builderIter = builderToByteString bsStep

144+ bsSink = C.Sink $ return $ C.SinkData push (return ())

145+ push bs = do

146+ liftIO $ outputH bs

147+ return C.Processing

148+ builderSink = builderToByteString C.=$ bsSink

144149 fixHeaders h =

145150 case lookup "content-type" h of

146151 Nothing -> ("Content-Type", "text/html; charset=utf-8") : h

@@ -159,21 +164,17 @@ cleanupVarName s =

159164 helper' (x:rest) = toLower x : helper' rest

160165 helper' [] = []

161166

162−requestBodyHandle :: Handle -> Int -> Enumerator B.ByteString IO a

163−requestBodyHandle h =

164− requestBodyFunc go

165− where

166− go i = Just `fmap` B.hGet h (min i defaultChunkSize)

167+requestBodyHandle :: Handle -> Int -> C.Source IO B.ByteString

168+requestBodyHandle h = requestBodyFunc $ \i -> do

169+ bs <- B.hGet h i

170+ return $ if B.null bs then Nothing else Just bs

167171

168−requestBodyFunc :: (Int -> IO (Maybe B.ByteString))

169− -> Int

170− -> Enumerator B.ByteString IO a

171−requestBodyFunc _ 0 step = returnI step

172−requestBodyFunc h len (Continue k) = do

173− mbs <- liftIO $ h len

174− case mbs of

175− Nothing -> continue k

176− Just bs -> do

177− let newLen = len - B.length bs

178− k (Chunks [bs]) >>== requestBodyFunc h newLen

179−requestBodyFunc _ _ step = returnI step

172+requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> C.Source IO B.ByteString

173+requestBodyFunc get count0 =

174+ C.sourceState count0 pull

175+ where

176+ pull 0 = return (0, C.Closed)

177+ pull count = do

178+ mbs <- liftIO $ get $ min count defaultChunkSize

179+ let count' = count - maybe 0 B.length mbs

180+ return (count', maybe C.Closed C.Open mbs)

wai-extra/Network/Wai/Middleware/Autohead.hs+1−6

@@ -5,7 +5,6 @@ module Network.Wai.Middleware.Autohead (autohead) where

55

66import Network.Wai

77import Data.Monoid (mempty)

8−import Data.Enumerator (enumEOF, ($$))

98

109autohead :: Middleware

1110autohead app req

@@ -14,10 +13,6 @@ autohead app req

1413 case res of

1514 ResponseFile s hs _ _ -> return $ ResponseBuilder s hs mempty

1615 ResponseBuilder s hs _ -> return $ ResponseBuilder s hs mempty

17− ResponseEnumerator e -> do

18− let helper f =

19− let helper' s hs = enumEOF $$ f s hs

20− in e helper'

21− return $ ResponseEnumerator helper

16+ ResponseSource s hs _ -> return $ ResponseBuilder s hs mempty

2217 | otherwise = app req

2318

wai-extra/Network/Wai/Middleware/Gzip.hs+27−22

@@ -25,18 +25,20 @@ module Network.Wai.Middleware.Gzip

2525 ) where

2626

2727import Network.Wai

28−import Network.Wai.Zlib

2928import Data.Maybe (fromMaybe)

30−import Data.Enumerator (($$), joinI, (=$), run)

31−import Data.Enumerator.Binary (enumFile, iterHandle)

3229import qualified Data.ByteString.Char8 as S8

3330import qualified Data.ByteString as S

3431import Data.Default

3532import Network.HTTP.Types (Status, Header)

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

37−import qualified Codec.Zlib.Enum as CZE

38−import qualified System.IO as SIO

3934import System.Directory (doesFileExist, createDirectoryIfMissing)

35+import qualified Data.Conduit as C

36+import qualified Data.Conduit.Zlib as CZ

37+import qualified Data.Conduit.Binary as CB

38+import qualified Data.Conduit.List as CL

39+import Data.Conduit.Blaze (builderToByteString)

40+import Blaze.ByteString.Builder (fromByteString)

41+import Control.Exception (try, SomeException)

4042

4143data GzipSettings = GzipSettings

4244 { gzipFiles :: GzipFiles

@@ -79,7 +81,7 @@ gzip' set app env = do

7981 Just m

8082 | gzipCheckMime set m -> liftIO $ compressFile s hs file cache

8183 _ -> return res

82− _ -> return $ ResponseEnumerator $ compressE set $ responseEnumerator res

84+ _ -> return $ compressE set res

8385 else return res

8486 where

8587 enc = fromMaybe [] $ (splitCommas . S8.unpack)

@@ -94,15 +96,16 @@ compressFile s hs file cache = do

9496 then onSucc

9597 else do

9698 createDirectoryIfMissing True cache

97− x <- SIO.withFile tmpfile SIO.WriteMode $ \h ->

98− run

99− $ enumFile file

100− $$ CZE.gzip

101− =$ iterHandle h

102− either (const onErr) (const onSucc) x

99+ x <-

100+ try $ C.runResourceT $ CB.sourceFile file

101+ C.$$ CZ.gzip C.=$ CB.sinkFile tmpfile

102+ either onErr (const onSucc) x

103103 where

104104 onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing

105− onErr = return $ ResponseFile s hs file Nothing

105+

106+ onErr :: SomeException -> IO Response

107+ onErr = const $ return $ ResponseFile s hs file Nothing -- FIXME log the error message

108+

106109 tmpfile = cache ++ '/' : map safe file

107110 safe c

108111 | 'A' <= c && c <= 'Z' = c

@@ -113,16 +116,18 @@ compressFile s hs file cache = do

113116 safe _ = '_'

114117

115118compressE :: GzipSettings

116− -> (forall a. ResponseEnumerator a)

117− -> (forall a. ResponseEnumerator a)

118−compressE set re f =

119− re f'

120− --e s hs'

119+ -> Response

120+ -> Response

121+compressE set res =

122+ case lookup "content-type" hs of

123+ Just m | gzipCheckMime set m ->

124+ let hs' = fixHeaders hs

125+ in ResponseSource s hs' $ b C.$= builderToByteString

126+ C.$= CZ.gzip

127+ C.$= CL.map fromByteString

128+ _ -> res

121129 where

122− f' s hs =

123− case lookup "content-type" hs of

124− Just m | gzipCheckMime set m -> joinI $ compress $$ f s (fixHeaders hs)

125− _ -> f s hs

130+ (s, hs, b) = responseSource res

126131

127132-- Remove Content-Length header, since we will certainly have a

128133-- different length after gzip compression.

wai-extra/Network/Wai/Middleware/Jsonp.hs+15−29

@@ -18,13 +18,13 @@ module Network.Wai.Middleware.Jsonp (jsonp) where

1818import Network.Wai

1919import Data.ByteString (ByteString)

2020import qualified Data.ByteString.Char8 as B8

21−import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==))

22−import Blaze.ByteString.Builder (copyByteString, Builder)

21+import Blaze.ByteString.Builder (copyByteString)

2322import Blaze.ByteString.Builder.Char8 (fromChar)

2423import Data.Monoid (mappend)

2524import Control.Monad (join)

2625import Data.Maybe (fromMaybe)

2726import qualified Data.ByteString as S

27+import qualified Data.Conduit.List as CL

2828

2929-- | Wrap json responses in a jsonp callback.

3030--

@@ -54,7 +54,6 @@ jsonp app env = do

5454 Nothing -> return res

5555 Just c -> go c res

5656 where

57− go c r@(ResponseFile _ hs _ _) = go' c r hs

5857 go c r@(ResponseBuilder s hs b) =

5958 case checkJSON hs of

6059 Nothing -> return r

@@ -63,39 +62,26 @@ jsonp app env = do

6362 `mappend` fromChar '('

6463 `mappend` b

6564 `mappend` fromChar ')'

66− go c (ResponseEnumerator e) = addCallback c e

67− go' c r hs =

65+ go c r =

6866 case checkJSON hs of

69− Just _ -> addCallback c $ responseEnumerator r

67+ Just hs' -> addCallback c s hs' b

7068 Nothing -> return r

69+ where

70+ (s, hs, b) = responseSource r

71+

7172 checkJSON hs =

7273 case lookup "Content-Type" hs of

7374 Just x

74− | B8.pack "application/json" `S.isPrefixOf` x -> Just $ fixHeaders hs

75+ | B8.pack "application/json" `S.isPrefixOf` x ->

76+ Just $ fixHeaders hs

7577 _ -> Nothing

7678 fixHeaders = changeVal "Content-Type" "text/javascript"

77− addCallback :: B8.ByteString -> (forall a. ResponseEnumerator a)

78− -> Iteratee B8.ByteString IO Response

79− addCallback cb e =

80− return $ ResponseEnumerator $ helper

81− where

82− helper f =

83− e helper'

84− where

85− helper' s hs =

86− case checkJSON hs of

87− Just hs' -> wrap $$ f s hs'

88− Nothing -> f s hs

89− wrap :: Step Builder IO b -> Iteratee Builder IO b

90− wrap step = joinI $ after (enumList 1 [fromChar ')'])

91− $$ enumList 1 [copyByteString cb, fromChar '('] step

92− after :: Enumerator Builder IO b -> Enumeratee Builder Builder IO b

93− after enum =

94− loop

95− where

96− loop = checkDone $ continue . step

97− step k EOF = enum (Continue k) >>== return

98− step k s = k s >>== loop

79+

80+ addCallback cb s hs b =

81+ return $ ResponseSource s hs $

82+ CL.sourceList [copyByteString cb `mappend` fromChar '(']

83+ `mappend` b

84+ `mappend` CL.sourceList [fromChar ')']

9985

10086changeVal :: Eq a

10187 => a

wai-extra/Network/Wai/Middleware/RequestLogger.hs+6−3

@@ -21,9 +21,11 @@ import qualified Data.Text.Encoding as TE

2121import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File)

2222import qualified Data.ByteString.Lazy as LBS

2323import Data.Enumerator (run_, ($$), enumList)

24−import Data.Enumerator.List (consume)

2524import System.IO (hPutStrLn, stderr)

2625

26+import qualified Data.Conduit as C

27+import qualified Data.Conduit.List as CL

28+

2729-- | like @logHandle@, but prints to 'stdout'

2830logStdout :: Middleware

2931logStdout = logHandle $ \bs -> hPutLogStr stdout [LB bs]

@@ -68,7 +70,7 @@ logHandleDevLT cb app req =

6870-- For production use use module Network.Wai.Middleware.RequestLogger

6971logHandleDev :: (BS.ByteString -> IO ()) -> Middleware

7072logHandleDev cb app req = do

71− body <- consume

73+ body <- requestBody req C.$$ CL.consume

7274 postParams <- if any (requestMethod req ==) ["GET", "HEAD"]

7375 then return []

7476 else do postParams <- liftIO $ allPostParams req body

@@ -86,7 +88,8 @@ logHandleDev cb app req = do

8688 , paramsToBS "POST " postParams

8789 ]

8890 -- we just consumed the body- fill the enumerator back up so it is available again

89− liftIO $ run_ $ enumList 1 body $$ app req

91+ body' <- C.bufferSource $ CL.sourceList body

92+ app req { requestBody = body' }

9093 where

9194 paramsToBS prefix params =

9295 if null params then ""

wai-extra/Network/Wai/Zlib.hsdeleted−41

@@ -1,41 +0,0 @@

1−module Network.Wai.Zlib (compress) where

2−

3−import Prelude hiding (head)

4−import Data.Enumerator

5− ( Enumeratee, checkDone, Stream (..)

6− , (>>==), ($$), joinI

7− )

8−import Data.Enumerator.List (head)

9−import Blaze.ByteString.Builder (Builder, fromByteString)

10−import Blaze.ByteString.Builder.Enumerator (builderToByteString)

11−import Control.Monad.IO.Class (liftIO)

12−

13−import Codec.Zlib

14−

15−-- Note: this function really should return a stream of ByteStrings, but the

16−-- WAI protocol needs Builders anyway.

17−compress :: Enumeratee Builder Builder IO a

18−compress step0 = joinI $ builderToByteString $$ do

19− def <- liftIO $ initDeflate 7 $ WindowBits 31

20− loop def step0

21− where

22− loop def = checkDone $ step def

23− step def k = do

24− minput <- head

25− case minput of

26− Nothing -> do

27− bss <- liftIO $ finishDeflate def drain

28− k (Chunks bss) >>== return

29− Just input -> do

30− bss <- liftIO $ withDeflateInput def input drain

31− case bss of

32− [] -> step def k

33− _ -> k (Chunks bss) >>== loop def

34− drain =

35− go id

36− where

37− go front mbs' = do

38− mbs <- mbs'

39− case mbs of

40− Nothing -> return $ map fromByteString $ front []

41− Just bs -> go (front . (:) bs) mbs'

wai-extra/wai-extra.cabal+10−9

@@ -1,5 +1,5 @@

11Name: wai-extra

2−Version: 0.4.6

2+Version: 1.0.0

33Synopsis: Provides some basic WAI handlers and middleware.

44Description: The goal here is to provide common features without many dependencies.

55License: BSD3

@@ -22,22 +22,24 @@ extra-source-files:

2222Library

2323 Build-Depends: base >= 4 && < 5

2424 , bytestring >= 0.9.1.4 && < 0.10

25− , wai >= 0.4 && < 0.5

25+ , wai >= 1.0 && < 1.1

2626 , old-locale >= 1.0.0.2 && < 1.1

2727 , time >= 1.1.4

2828 , network >= 2.2.1.5 && < 2.4

2929 , directory >= 1.0.1 && < 1.2

3030 , zlib-bindings >= 0.0 && < 0.1

31− , blaze-builder-enumerator >= 0.2 && < 0.3

3231 , transformers >= 0.2.2 && < 0.3

33− , enumerator >= 0.4.8 && < 0.5

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

3533 , http-types >= 0.6 && < 0.7

3634 , text >= 0.7 && < 0.12

3735 , case-insensitive >= 0.2

38− , zlib-enum >= 0.2.1 && < 0.3

3936 , data-default >= 0.3 && < 0.4

4037 , fast-logger >= 0.0.1

38+ , conduit

39+ , zlib-conduit

40+ , blaze-builder-conduit

41+ -- FIXME this must be removed

42+ , enumerator

4143

4244 Exposed-modules: Network.Wai.Handler.CGI

4345 Network.Wai.Middleware.AcceptOverride

@@ -50,7 +52,6 @@ Library

5052 Network.Wai.Middleware.MethodOverride

5153 Network.Wai.Middleware.Rewrite

5254 Network.Wai.Middleware.Vhost

53− Network.Wai.Zlib

5455 Network.Wai.Parse

5556 ghc-options: -Wall

5657

@@ -69,16 +70,16 @@ test-suite tests

6970 , wai

7071 , http-types

7172 , transformers

72− , enumerator

7373 , zlib

7474 , text

7575 , bytestring

7676 , directory

7777 , zlib-bindings

78− , blaze-builder-enumerator >= 0.2 && < 0.3

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

80− , zlib-enum

8179 , data-default

80+ , conduit

81+ -- FIXME this must be removed

82+ , enumerator

8283

8384source-repository head

8485 type: git

wai-handler-devel/wai-handler-devel.cabal+6−6

@@ -1,5 +1,5 @@

11Name: wai-handler-devel

2−Version: 0.4.4.1

2+Version: 1.0.0

33Synopsis: WAI server that automatically reloads code after modification.

44Description: This handler automatically reloads your source code upon any changes. It works by using the hint package, essentially embedding GHC inside the handler. The handler (both the executable and library) takes three arguments: the port to listen on, the module name containing the application function, and the name of the function.

55 .

@@ -10,7 +10,7 @@ License: BSD3

1010License-file: LICENSE

1111Author: Michael Snoyman

1212Maintainer: michael@snoyman.com

13−Homepage: http://github.com/snoyberg/wai-handler-devel

13+Homepage: http://github.com/yesodweb/wai

1414Category: Web

1515Build-Type: Simple

1616Cabal-Version: >=1.6

@@ -18,14 +18,14 @@ Stability: Stable

1818

1919Source-repository head

2020 type: git

21− location: git://github.com/snoyberg/wai-handler-devel.git

21+ location: git://github.com/yesodweb/wai.git

2222

2323Library

2424 Build-Depends: base >= 4 && < 5

25− , wai >= 0.4 && < 0.5

26− , wai-extra >= 0.4 && < 0.5

25+ , wai >= 1.0 && < 1.1

26+ , wai-extra >= 1.0 && < 1.1

2727 , http-types >= 0.6 && < 0.7

28− , warp >= 0.4 && < 0.5

28+ , warp >= 1.0 && < 1.1

2929 , directory >= 1.0.1 && < 1.2

3030 , network >= 2.2.1.5 && < 2.4

3131 , bytestring >= 0.9.1.4 && < 0.10

wai-handler-fastcgi/wai-handler-fastcgi.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-fastcgi

2−version: 0.4.2

2+version: 1.0.0

33license: BSD3

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -15,8 +15,8 @@ description: Calls out to the libfcgi C library.

1515

1616library

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

18− , wai >= 0.4 && < 0.5

19− , wai-extra >= 0.4 && < 0.5

18+ , wai >= 1.0 && < 1.1

19+ , wai-extra >= 1.0 && < 1.1

2020 , bytestring >= 0.9.1.4 && < 0.10

2121 exposed-modules: Network.Wai.Handler.FastCGI

2222 ghc-options: -Wall

wai-handler-launch/Network/Wai/Handler/Launch.hs+38−58

@@ -13,7 +13,6 @@ import Data.IORef

1313import Control.Concurrent

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

1515import qualified Data.ByteString as S

16−import Data.Enumerator (($$), joinI, Enumeratee, Stream (..), Iteratee (..), Step (..))

1716import Blaze.ByteString.Builder (fromByteString)

1817#if WINDOWS

1918import Foreign

@@ -21,10 +20,10 @@ import Foreign.C.String

2120#else

2221import System.Cmd (rawSystem)

2322#endif

24−import Codec.Zlib.Enum (ungzip)

25−import Blaze.ByteString.Builder.Enumerator (builderToByteString)

26−import qualified Data.Enumerator.List as EL

27−import Control.Monad.Trans.Class (lift)

23+import Data.Conduit.Zlib (ungzip)

24+import Data.Conduit.Blaze (builderToByteString)

25+import qualified Data.Conduit as C

26+import qualified Data.Conduit.List as CL

2827

2928ping :: IORef Bool -> Middleware

3029ping var app req

@@ -42,64 +41,45 @@ ping var app req

4241 | not $ isHtml hs -> return res

4342 ResponseBuilder _ hs _

4443 | not $ isHtml hs -> return res

44+ ResponseSource _ hs _

45+ | not $ isHtml hs -> return res

4546 _ -> do

46− let renum = responseEnumerator res

47− return $ ResponseEnumerator $ \f -> renum $ \status headers ->

48− if isHtml headers

49− then do

50− let (isEnc, headers') = fixHeaders id headers

51− let headers'' = filter (\(x, _) -> x /= "content-length") headers'

52− let fixEnc x =

53− if isEnc

54− then joinI $ ungzip $$ x

55− else x

56− joinI $ builderToByteString $$ fixEnc $ joinI $ insideHead "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping\",false);x.send();},60000)</script>" $$ joinI $ EL.map fromByteString $$ f status headers''

57− else f status headers

47+ let (s, hs, body) = responseSource res

48+ let (isEnc, headers') = fixHeaders id hs

49+ let headers'' = filter (\(x, _) -> x /= "content-length") headers'

50+ let fixEnc src = if isEnc then src C.$= ungzip else src

51+ return $ ResponseSource s headers''

52+ $ fixEnc (body C.$= builderToByteString)

53+ C.$= insideHead

54+ C.$= CL.map fromByteString

55+

56+toInsert :: S.ByteString

57+toInsert = "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping\",false);x.send();},60000)</script>"

5858

59−insideHead :: S.ByteString -> Enumeratee S.ByteString S.ByteString IO a

60−insideHead toInsert =

61− go "" whole

59+insideHead :: C.Conduit S.ByteString IO S.ByteString

60+insideHead =

61+ C.conduitState (Just (S.empty, whole)) push close

6262 where

6363 whole = "<head>"

64− go :: S.ByteString -> S.ByteString -> Step S.ByteString IO a -> Iteratee S.ByteString IO (Step S.ByteString IO a)

65− go held atFront step = do

66− mx <- EL.head

67− case mx of

68− Nothing -> feedDone $ Chunks [held, toInsert]

69− Just x

70− | atFront `S.isPrefixOf` x -> do

71− let y = S.drop (S.length atFront) x

72− let stream = Chunks [held, atFront, toInsert, y]

73− feedDone stream

74− | whole `S.isInfixOf` x -> do

75− let (before, rest) = S.breakSubstring whole x

76− let after = S.drop (S.length whole) rest

77− feedDone $ Chunks [held, before, whole, toInsert, after]

78− | x `S.isPrefixOf` atFront -> go

79− (held `S.append` x)

80− (S.drop (S.length x) atFront)

81− step

82− | otherwise -> do

83− let (held', atFront', x') = getOverlap whole x

84− feedCont held' atFront' $ Chunks [held, x']

85− where

86− --feedDone :: Stream S.ByteString -> Iteratee S.ByteString IO (Step S.ByteString IO a)

87− feedDone stream =

88− case step of

89− Continue k -> do

90− step' <- lift $ runIteratee $ k stream

91− EL.map id step'

92− Yield b s -> return $ Yield b s

93− Error e -> return $ Error e

64+ push (Just (held, atFront)) x

65+ | atFront `S.isPrefixOf` x = do

66+ let y = S.drop (S.length atFront) x

67+ return (Nothing, C.Producing [held, atFront, toInsert, y])

68+ | whole `S.isInfixOf` x = do

69+ let (before, rest) = S.breakSubstring whole x

70+ let after = S.drop (S.length whole) rest

71+ return (Nothing, C.Producing [held, before, whole, toInsert, after])

72+ | x `S.isPrefixOf` atFront = do

73+ let held' = held `S.append` x

74+ atFront' = S.drop (S.length x) atFront

75+ return (Just (held', atFront'), C.Producing [])

76+ | otherwise = do

77+ let (held', atFront', x') = getOverlap whole x

78+ return (Just (held', atFront'), C.Producing [held, x'])

79+ push Nothing x = return (Nothing, C.Producing [x])

9480

95− --feedCont :: Monad m => S.ByteString -> S.ByteString -> Stream S.ByteString -> Iteratee S.ByteString m (Step S.ByteString m a)

96− feedCont held' atFront' stream = do

97− case step of

98− Continue k -> do

99− step' <- lift $ runIteratee $ k stream

100− go held' atFront' step'

101− Yield b s -> return $ Yield b s

102− Error e -> return $ Error e

81+ close (Just (held, _)) = return [held, toInsert]

82+ close Nothing = return []

10383

10484getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)

10585getOverlap whole x =

wai-handler-launch/wai-handler-launch.cabal+6−4

@@ -1,5 +1,5 @@

11Name: wai-handler-launch

2−Version: 0.0.4

2+Version: 1.0.0

33Synopsis: Launch a web app in the default browser.

44Description: This handles cross-platform launching and inserts Javascript code to ping the server. When the server no longer receives pings, it shuts down.

55License: BSD3

@@ -13,15 +13,17 @@ Cabal-version: >=1.2

1313Library

1414 Exposed-modules: Network.Wai.Handler.Launch

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

16− , wai >= 0.4 && < 0.5

17− , warp >= 0.4 && < 0.5

16+ , wai >= 1.0 && < 1.1

17+ , warp >= 1.0 && < 1.1

1818 , http-types >= 0.6 && < 0.7

1919 , transformers >= 0.2.2 && < 0.3

2020 , bytestring >= 0.9.1.4 && < 0.10

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

2222 , enumerator >= 0.4.8 && < 0.5

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

24− , zlib-enum >= 0.2.1 && < 0.3

24+ , conduit

25+ , blaze-builder-conduit

26+ , zlib-conduit

2527

2628 if os(windows)

2729 c-sources: windows.c

wai-handler-scgi/wai-handler-scgi.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-scgi

2−version: 0.4.1

2+version: 1.0.0

33license: BSD3

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -14,8 +14,8 @@ description: Wai handler to SCGI

1414

1515library

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

17− , wai >= 0.4 && < 0.5

18− , wai-extra >= 0.4 && < 0.5

17+ , wai >= 1.0 && < 1.1

18+ , wai-extra >= 1.0 && < 1.1

1919 , bytestring >= 0.9.1.4 && < 0.10

2020 exposed-modules: Network.Wai.Handler.SCGI

2121 ghc-options: -Wall

wai-handler-webkit/wai-handler-webkit.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-webkit

2−version: 0.3.0

2+version: 1.0.0

33license: BSD3

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -16,8 +16,8 @@ homepage: http://www.yesodweb.com/book/wai

1616

1717library

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

19− , wai >= 0.4 && < 0.5

20− , warp >= 0.4 && < 0.5

19+ , wai >= 1.0 && < 1.1

20+ , warp >= 1.0 && < 1.1

2121 ghc-options: -Wall

2222 exposed-modules: Network.Wai.Handler.Webkit

2323 c-sources: webkit.cpp

wai-test/Network/Wai/Test.hs+17−14

@@ -26,14 +26,14 @@ import Data.Map (Map)

2626import qualified Data.Map as Map

2727import Data.ByteString (ByteString)

2828import qualified Data.ByteString.Char8 as S8

29−import Data.Enumerator (joinI, ($$), run_, enumList)

30−import Data.Enumerator.List (consume)

31−import Blaze.ByteString.Builder.Enumerator (builderToByteString)

29+import Data.Conduit.Blaze (builderToByteString)

3230import qualified Data.ByteString.Lazy as L

3331import qualified Data.ByteString.Lazy.Char8 as L8

3432import qualified Network.HTTP.Types as H

3533import Data.CaseInsensitive (CI)

3634import qualified Data.ByteString as S

35+import qualified Data.Conduit as C

36+import qualified Data.Conduit.List as CL

3737

3838type Session = ReaderT Application (StateT ClientState IO)

3939

@@ -73,23 +73,26 @@ defaultRequest = Request

7373 , remoteHost = error "Network.Wai.Test.defaultRequest{remoteHost}"

7474 , pathInfo = []

7575 , queryString = []

76+ , requestBody = error "requestBody of defaultRequest"

7677 }

7778

7879srequest :: SRequest -> Session SResponse

7980srequest (SRequest req bod) = do

8081 app <- ask

81− res <- liftIO $ run_ $ enumList 4 (L.toChunks bod) $$ app req

82− sres <- liftIO $ runResponse res

83− -- FIXME cookie processing

84− return sres

85−

86−runResponse :: Response -> IO SResponse

87−runResponse res =

88− responseEnumerator res go

82+ liftIO $ C.runResourceT $ do

83+ body <- C.bufferSource $ CL.sourceList $ L.toChunks bod

84+ let req' = req { requestBody = body }

85+ res <- app req'

86+ sres <- runResponse res

87+ -- FIXME cookie processing

88+ return sres

89+

90+runResponse :: Response -> C.ResourceT IO SResponse

91+runResponse res = do

92+ bss <- body C.$= builderToByteString C.$$ CL.consume

93+ return $ SResponse s h $ L.fromChunks bss

8994 where

90− go s h = do

91− bss <- joinI $ builderToByteString $$ consume

92− return $ SResponse s h $ L.fromChunks bss

95+ (s, h, body) = responseSource res

9396

9497assertBool :: String -> Bool -> Session ()

9598assertBool s b = liftIO $ H.assertBool s b

wai-test/wai-test.cabal+4−4

@@ -1,5 +1,5 @@

11name: wai-test

2−version: 0.1.3.1

2+version: 1.0

33license: BSD3

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -14,14 +14,14 @@ description: Unit test framework (built on HUnit) for WAI applications.

1414

1515library

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

17− , wai >= 0.4 && < 0.5

17+ , wai >= 1.0 && < 1.1

1818 , bytestring >= 0.9.1.4 && < 0.10

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

2020 , transformers >= 0.2.2 && < 0.3

2121 , containers >= 0.2 && < 0.5

22− , enumerator >= 0.4.8 && < 0.5

22+ , conduit >= 0.0 && < 0.1

23+ , blaze-builder-conduit >= 0.0 && < 0.1

2324 , cookie >= 0.2 && < 0.4

24− , blaze-builder-enumerator >= 0.2 && < 0.3

2525 , HUnit >= 1.2 && < 1.3

2626 , http-types >= 0.6 && < 0.7

2727 , case-insensitive >= 0.2

wai-websockets/wai-websockets.cabal+2−2

@@ -1,5 +1,5 @@

11Name: wai-websockets

2−Version: 0.5.0.1

2+Version: 1.0.0

33Synopsis: Provide a bridge betweeen WAI and the websockets package.

44License: BSD3

55License-file: LICENSE

@@ -19,7 +19,7 @@ flag example

1919Library

2020 Build-Depends: base >= 3 && < 5

2121 , bytestring >= 0.9.1.4 && < 0.10

22− , wai >= 0.4 && < 0.5

22+ , wai >= 1.0 && < 1.1

2323 , enumerator >= 0.4.8 && < 0.5

2424 , network-enumerator >= 0.1.2 && < 0.2

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

wai/Network/Wai.hs+21−28

@@ -39,8 +39,7 @@ module Network.Wai

3939 ( -- * WAI interface

4040 Request (..)

4141 , Response (..)

42− , ResponseStream

43− , responseStream

42+ , responseSource

4443 , Application

4544 , Middleware

4645 , FilePart (..)

@@ -61,7 +60,6 @@ import qualified Network.HTTP.Types as H

6160import Data.Text (Text)

6261import Data.ByteString.Lazy.Char8 () -- makes it easier to use responseLBS

6362import Blaze.ByteString.Builder (fromByteString)

64−import Filesystem.Path.CurrentOS (decodeString)

6563

6664-- | Information on the request sent by the client. This abstracts away the

6765-- details of the underlying implementation.

@@ -96,21 +94,10 @@ data Request = Request

9694 , pathInfo :: [Text]

9795 -- | Parsed query string information

9896 , queryString :: H.Query

99− , requestBody :: C.BSource IO B.ByteString

97+ , requestBody :: C.BufferedSource IO B.ByteString

10098 }

10199 deriving (Typeable)

102100

103−data Response

104− = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart)

105− | ResponseBuilder H.Status H.ResponseHeaders Builder

106− | ResponseStream (forall a. ResponseStream a)

107− deriving Typeable

108−

109−data FilePart = FilePart

110− { filePartOffset :: Integer

111− , filePartByteCount :: Integer

112− } deriving Show

113−

114101-- |

115102--

116103-- Some questions and answers about the usage of 'Builder' here:

@@ -134,23 +121,29 @@ data FilePart = FilePart

134121--

135122-- A3. You can force blaze-builder to output a ByteString before it is an

136123-- optimal size by sending a flush command.

124+data Response

125+ = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart)

126+ | ResponseBuilder H.Status H.ResponseHeaders Builder

127+ | ResponseSource H.Status H.ResponseHeaders (C.Source IO Builder)

128+ deriving Typeable

137129

138−type ResponseStream a =

139− (H.Status -> H.ResponseHeaders -> C.SinkM Builder IO a)

140− -> ResourceT IO a

130+data FilePart = FilePart

131+ { filePartOffset :: Integer

132+ , filePartByteCount :: Integer

133+ } deriving Show

141134

142−responseStream :: Response -> ResponseStream a

143−responseStream (ResponseStream e) f = e f

144−responseStream (ResponseFile s h fp (Just part)) f =

145− sourceFilePart part fp C.$$ CL.map fromByteString C.=$ f s h

146−responseStream (ResponseFile s h fp Nothing) f =

147− CB.sourceFile (decodeString fp) C.$$ CL.map fromByteString C.=$ f s h

148−responseStream (ResponseBuilder s h b) f =

149− CL.fromList [b] C.$$ f s h

135+responseSource :: Response -> (H.Status, H.ResponseHeaders, C.Source IO Builder) -- FIXME re-analyze usage of Builder

136+responseSource (ResponseSource s h b) = (s, h, b)

137+responseSource (ResponseFile s h fp (Just part)) =

138+ (s, h, sourceFilePart part fp C.$= CL.map fromByteString)

139+responseSource (ResponseFile s h fp Nothing) =

140+ (s, h, CB.sourceFile fp C.$= CL.map fromByteString)

141+responseSource (ResponseBuilder s h b) =

142+ (s, h, CL.sourceList [b])

150143

151−sourceFilePart :: FilePart -> FilePath -> C.SourceM IO B.ByteString

144+sourceFilePart :: FilePart -> FilePath -> C.Source IO B.ByteString

152145sourceFilePart (FilePart offset count) fp =

153− CB.sourceFileRange (decodeString fp) (Just offset) (Just count)

146+ CB.sourceFileRange fp (Just offset) (Just count)

154147

155148responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response

156149responseLBS s h = ResponseBuilder s h . fromLazyByteString

wai/wai.cabal−1

@@ -25,6 +25,5 @@ Library

2525 , http-types >= 0.6 && < 0.7

2626 , text >= 0.7 && < 0.12

2727 , transformers >= 0.2.2 && < 0.3

28− , system-filepath >= 0.4.3 && < 0.5

2928 Exposed-modules: Network.Wai

3029 ghc-options: -Wall

warp-static/warp-static.cabal+4−4

@@ -1,5 +1,5 @@

11Name: warp-static

2−Version: 0.2.2

2+Version: 1.0.0

33Synopsis: Static file server based on Warp and wai-app-static

44Homepage: http://github.com/yesodweb/wai

55License: BSD3

@@ -15,9 +15,9 @@ Description: Serve up static files by running the warp executable. Based

1515Executable warp

1616 Main-is: warp.hs

1717 Build-depends: base >= 4 && < 5

18− , warp >= 0.4 && < 0.5

19− , wai-app-static >= 0.3 && < 0.4

20− , wai-extra >= 0.4 && < 0.5

18+ , warp >= 1.0 && < 1.1

19+ , wai-app-static >= 1.0 && < 1.1

20+ , wai-extra >= 1.0 && < 1.1

2121 , cmdargs >= 0.6.7

2222 , directory >= 1.0

2323 , containers >= 0.2 && < 0.5

warp/Network/Wai/Handler/Warp.hs+63−74

@@ -96,7 +96,7 @@ import Blaze.ByteString.Builder.HTTP

9696import Blaze.ByteString.Builder

9797 (copyByteString, Builder, toLazyByteString, toByteStringIO)

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

99−import Data.Monoid (mappend, mconcat)

99+import Data.Monoid (mappend)

100100import Network.Sendfile

101101

102102import qualified System.PosixCompat.Files as P

@@ -211,12 +211,13 @@ serveConnection settings th onException port app conn remoteHost' = do

211211 serveConnection' :: ResourceT IO ()

212212 serveConnection' = do

213213 fromClient <- C.bufferSource $ sourceSocket th bytesPerRead conn

214− (len, env) <- parseRequest port remoteHost' fromClient

214+ env <- parseRequest port remoteHost' fromClient

215215 case settingsIntercept settings env of

216216 Nothing -> do

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

218218 liftIO $ T.pause th

219219 res <- app env

220+ -- FIXME flush the rest of the request body

220221 liftIO $ T.resume th

221222 keepAlive <- sendResponse th env conn res

222223 if keepAlive then serveConnection' else return ()

@@ -225,8 +226,8 @@ serveConnection settings th onException port app conn remoteHost' = do

225226 intercept fromClient conn

226227

227228parseRequest :: Port -> SockAddr

228− -> C.BSource IO S.ByteString

229− -> ResourceT IO (Integer, Request)

229+ -> C.BufferedSource IO S.ByteString

230+ -> ResourceT IO Request

230231parseRequest port remoteHost' src = do

231232 headers' <- takeHeaders src

232233 parseRequest' port headers' remoteHost' src

@@ -250,8 +251,8 @@ instance Exception InvalidRequest

250251parseRequest' :: Port

251252 -> [ByteString]

252253 -> SockAddr

253− -> C.BSource IO S.ByteString

254− -> ResourceT IO (Integer, Request)

254+ -> C.BufferedSource IO S.ByteString

255+ -> ResourceT IO Request

255256parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []

256257parseRequest' port (firstLine:otherLines) remoteHost' src = do

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

@@ -270,21 +271,21 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

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

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

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

273− rbody <- C.bufferSource $ src C.$= CB.isolate (fromIntegral len)

274− return (len, Request

275− { requestMethod = method

276− , httpVersion = httpversion

277− , pathInfo = H.decodePathSegments rpath

278− , rawPathInfo = rpath

279− , rawQueryString = gets

280− , queryString = H.parseQuery gets

281− , serverName = serverName'

282− , serverPort = port

283− , requestHeaders = heads

284− , isSecure = False

285− , remoteHost = remoteHost'

286− , requestBody = rbody

287− })

274+ rbody <- C.bufferSource $ src C.$= CB.isolate len

275+ return Request

276+ { requestMethod = method

277+ , httpVersion = httpversion

278+ , pathInfo = H.decodePathSegments rpath

279+ , rawPathInfo = rpath

280+ , rawQueryString = gets

281+ , queryString = H.parseQuery gets

282+ , serverName = serverName'

283+ , serverPort = port

284+ , requestHeaders = heads

285+ , isSecure = False

286+ , remoteHost = remoteHost'

287+ , requestBody = rbody

288+ }

288289

289290

290291takeUntil :: Word8 -> ByteString -> ByteString

@@ -427,41 +428,33 @@ sendResponse th req socket r = sendResponse' r

427428 `mappend` chunkedTransferTerminator

428429 else (headers' False) `mappend` b

429430

430− sendResponse' (ResponseStream res) =

431− res enumResponse

431+ sendResponse' (ResponseSource s hs body) =

432+ response

432433 where

433− enumResponse :: H.Status -> H.ResponseHeaders -> C.SinkM Builder IO Bool

434− enumResponse s hs =

435− response

436− where

437− headers' = headers version s hs

438− -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)

439− response

440− | not (hasBody s req) = do

441− liftIO $ Sock.sendMany socket

442− $ L.toChunks $ toLazyByteString

443− $ headers' False

444− return (checkPersist req)

445− | otherwise = C.SinkM $ do

446− let sink = builderToByteString C.=$ sinkSocket th (isKeepAlive hs) socket

447− CL.fromList [headers' needsChunked'] C.$$ sink

448− C.genSink $ chunk' sink

449− needsChunked' = needsChunked hs

450− chunk' sink = if needsChunked'

451− then chunk C.=$ sink

452− else sink

453− chunk :: C.ConduitM Builder IO Builder

454− chunk = C.ConduitM $ return $ C.Conduit

455− { C.conduitPush = push

456− , C.conduitClose = close

457− }

458−

459− go [] = id

460− go [x] = (chunkedTransferEncoding x:)

461− go xs = (chunkedTransferEncoding (mconcat xs):)

462−

463− push xs = return $ C.ConduitResult C.Processing $ go xs []

464− close xs = return $ C.ConduitResult [] $ go xs [chunkedTransferTerminator]

434+ headers' = headers version s hs

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

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

437+ response

438+ | not (hasBody s req) = do

439+ liftIO $ Sock.sendMany socket

440+ $ L.toChunks $ toLazyByteString

441+ $ headers' False

442+ return (checkPersist req)

443+ | otherwise = do

444+ let src =

445+ CL.sourceList [headers' needsChunked'] `mappend`

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

447+ src C.$$ builderToByteString C.=$ sinkSocket th socket

448+ return $ isKeepAlive hs

449+ needsChunked' = needsChunked hs

450+ chunk :: C.Conduit Builder IO Builder

451+ chunk = C.Conduit $ return $ C.PreparedConduit

452+ { C.conduitPush = push

453+ , C.conduitClose = close

454+ }

455+

456+ push x = return $ C.Producing [chunkedTransferEncoding x]

457+ close = return [chunkedTransferTerminator]

465458

466459parseHeaderNoAttr :: ByteString -> H.Header

467460parseHeaderNoAttr s =

@@ -473,14 +466,14 @@ parseHeaderNoAttr s =

473466 else rest

474467 in (CI.mk k, rest')

475468

476−sourceSocket :: T.Handle -> Int -> Socket -> C.Source IO ByteString

477−sourceSocket th len socket = C.Source

469+sourceSocket :: T.Handle -> Int -> Socket -> C.PreparedSource IO ByteString

470+sourceSocket th len socket = C.PreparedSource

478471 { C.sourcePull = do

479472 bs <- liftIO $ Sock.recv socket len

480473 liftIO $ T.tickle th

481474 return $ if S.null bs

482− then C.SourceResult C.StreamClosed []

483− else C.SourceResult C.StreamOpen [bs]

475+ then C.Closed

476+ else C.Open bs

484477 , C.sourceClose = return ()

485478 }

486479

@@ -488,23 +481,19 @@ sourceSocket th len socket = C.Source

488481--separate package.

489482

490483sinkSocket :: T.Handle

491− -> ret

492484 -> Socket

493− -> C.SinkM B.ByteString IO ret

494−sinkSocket th ret sock = C.SinkM $ return $ C.SinkData

485+ -> C.Sink B.ByteString IO ()

486+sinkSocket th sock = C.Sink $ return $ C.SinkData

495487 { C.sinkPush = push

496488 , C.sinkClose = close

497489 }

498490 where

499− close xs = do

491+ close = do

500492 liftIO (T.resume th)

501− liftIO $ Sock.sendMany sock xs

502− liftIO (T.resume th)

503− return (C.SinkResult [] ret)

504− push [] = return $ C.Processing

505− push xs = do

493+ return ()

494+ push x = do

506495 liftIO $ T.resume th

507− liftIO $ Sock.sendMany sock xs

496+ liftIO $ Sock.sendAll sock x

508497 liftIO $ T.pause th

509498 return $ C.Processing

510499 -- We pause timeouts before passing control back to user code. This ensures

@@ -523,7 +512,7 @@ data Settings = Settings

523512 , settingsHost :: String -- ^ Host to bind to, or * for all. Default value: *

524513 , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.

525514 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30

526− , settingsIntercept :: Request -> Maybe (C.BSource IO S.ByteString -> Socket -> ResourceT IO ())

515+ , settingsIntercept :: Request -> Maybe (C.BufferedSource IO S.ByteString -> Socket -> ResourceT IO ())

527516 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'

528517 }

529518

@@ -550,7 +539,7 @@ defaultSettings = Settings

550539 go' (Just ThreadKilled) = False

551540 go' _ = True

552541

553−takeHeaders :: C.BSource IO ByteString -> ResourceT IO [ByteString]

542+takeHeaders :: C.BufferedSource IO ByteString -> ResourceT IO [ByteString]

554543takeHeaders src = do

555544 !x <- forceHead ConnectionClosedByPeer src

556545 takeHeaders' 0 id id x src

@@ -561,7 +550,7 @@ takeHeaders' :: Int

561550 -> ([ByteString] -> [ByteString])

562551 -> ([ByteString] -> [ByteString])

563552 -> ByteString

564− -> C.BSource IO ByteString

553+ -> C.BufferedSource IO ByteString

565554 -> ResourceT IO [ByteString]

566555takeHeaders' !len _ _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader

567556takeHeaders' !len !lines !prepend !bs src = do

@@ -590,7 +579,7 @@ takeHeaders' !len !lines !prepend !bs src = do

590579 if start < bsLen

591580 then {-# SCC "takeHeaders'.noMoreHeaders.yield" #-} do

592581 let !rest = {-# SCC "takeHeaders'.noMoreHeaders.yield.rest" #-} SU.unsafeDrop start bs

593− C.bsourceUnpull src [rest]

582+ C.bsourceUnpull src rest

594583 return lines'

595584 else return lines'

596585

@@ -606,7 +595,7 @@ takeHeaders' !len !lines !prepend !bs src = do

606595{-# INLINE takeHeaders' #-}

607596

608597forceHead :: InvalidRequest

609− -> C.BSource IO ByteString

598+ -> C.BufferedSource IO ByteString

610599 -> ResourceT IO ByteString

611600forceHead err src = do

612601 !mx <- src C.$$ CL.head

warp/warp.cabal+1

@@ -21,6 +21,7 @@ Library

2121 , wai >= 1.0 && < 1.1

2222 , transformers >= 0.2.2 && < 0.3

2323 , conduit >= 0.0 && < 0.1

24+ , blaze-builder-conduit >= 0.0 && < 0.1

2425 , lifted-base >= 0.1 && < 0.2

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

2627 , simple-sendfile >= 0.1 && < 0.3