615e384 · typeable/wai

git.iko.soy/typeable/wai

Merge branch 'fix-blaze' (#422)

commit615e3845e023104b7a07d8cba6c5831fd538ca68 authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 11 Aug 2015, 14:48 (11 years ago) parent5c8aa9f c43251b

7 files changed+35−81

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Buffer.hs+3−3 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+1−1 warp/Network/Wai/Handler/Warp/IO.hs+2−38 warp/Network/Wai/Handler/Warp/Response.hs+9−8 warp/Network/Wai/Handler/Warp/Settings.hs+5−4 warp/test/RunSpec.hs+11−11 warp/warp.cabal+4−16

warp/Network/Wai/Handler/Warp/Buffer.hs+3−3

@@ -7,7 +7,7 @@ module Network.Wai.Handler.Warp.Buffer (

77 , mallocBS

88 , newBufferPool

99 , withBufferPool

10− , toBlazeBuffer

10+ , toBuilderBuffer

1111 , copy

1212 , bufferIO

1313 ) where

@@ -88,8 +88,8 @@ withBufferPool pool f = do

8888-- Utilities

8989--

9090

91−toBlazeBuffer :: Buffer -> BufSize -> IO B.Buffer

92−toBlazeBuffer ptr size = do

91+toBuilderBuffer :: Buffer -> BufSize -> IO B.Buffer

92+toBuilderBuffer ptr size = do

9393 fptr <- newForeignPtr_ ptr

9494 return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size)

9595

warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+1−1

@@ -3,7 +3,7 @@

44module Network.Wai.Handler.Warp.HTTP2.Types where

6−import Blaze.ByteString.Builder (Builder)

6+import Data.ByteString.Builder (Builder)

77#if __GLASGOW_HASKELL__ < 709

88import Control.Applicative ((<$>),(<*>))

99#endif

warp/Network/Wai/Handler/Warp/IO.hs+2−38

@@ -4,19 +4,11 @@

44module Network.Wai.Handler.Warp.IO where

66import Data.ByteString (ByteString)

7+import Data.ByteString.Builder (Builder)

8+import Data.ByteString.Builder.Extra (runBuilder, Next(Done, More, Chunk))

79import Network.Wai.Handler.Warp.Buffer

810import Network.Wai.Handler.Warp.Types

911

10−-- Support for doctest, where cabal macros are not available

11−#ifndef MIN_VERSION_blaze_builder

12−#define MIN_VERSION_blaze_builder(x, y, z) 1

13−#endif

14−

15−#if MIN_VERSION_blaze_builder(0,4,0)

16−

17−import Blaze.ByteString.Builder (Builder)

18−import Data.ByteString.Builder.Extra (runBuilder, Next(Done, More, Chunk))

19−

2012toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()

2113toBufIOWith buf !size io builder = loop firstWriter

2214 where

@@ -35,31 +27,3 @@ toBufIOWith buf !size io builder = loop firstWriter

3527 runIO len

3628 io bs

3729 loop next

38−

39−#else /* !MIN_VERSION_blaze_builder(0,4,0) */

40−

41−import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep)

42−import Foreign.Ptr (plusPtr, minusPtr)

43−

44−toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()

45−toBufIOWith buf !size io (Builder build) = loop firstStep

46− where

47− firstStep = build (buildStep finalStep)

48− finalStep (BufRange p _) = return $ Done p ()

49− bufRange = BufRange buf (buf `plusPtr` size)

50− runIO ptr = bufferIO buf (ptr `minusPtr` buf) io

51− loop step = do

52− signal <- runBuildStep step bufRange

53− case signal of

54− Done ptr _ -> runIO ptr

55− BufferFull minSize ptr next

56− | size < minSize -> error "toBufIOWith: BufferFull: minSize"

57− | otherwise -> do

58− runIO ptr

59− loop next

60− InsertByteString ptr bs next -> do

61− runIO ptr

62− io bs

63− loop next

64−

65−#endif /* !MIN_VERSION_blaze_builder(0,4,0) */

warp/Network/Wai/Handler/Warp/Response.hs+9−8

@@ -18,17 +18,17 @@ module Network.Wai.Handler.Warp.Response (

1818#define MIN_VERSION_base(x,y,z) 1

1919#endif

2020

21−import Blaze.ByteString.Builder (fromByteString, Builder, flush)

2221import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator)

2322#if __GLASGOW_HASKELL__ < 709

2423import Control.Applicative

2524#endif

2625import Control.Exception

26+import Control.Monad (unless, when)

2727import Data.Array ((!))

2828import Data.ByteString (ByteString)

29−import Data.Streaming.Blaze (newBlazeRecv, reuseBufferStrategy)

3029import qualified Data.ByteString as S

31−import Control.Monad (unless, when)

30+import Data.ByteString.Builder (byteString, Builder)

31+import Data.ByteString.Builder.Extra (flush)

3232import qualified Data.ByteString.Char8 as B (pack)

3333import qualified Data.CaseInsensitive as CI

3434import Data.Function (on)

@@ -42,10 +42,11 @@ import Data.Monoid ((<>))

4242#else

4343import Data.Monoid (mappend, mempty)

4444#endif

45+import Data.Streaming.Blaze (newBlazeRecv, reuseBufferStrategy)

4546import Data.Version (showVersion)

4647import qualified Network.HTTP.Types as H

4748import Network.Wai

48−import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer)

49+import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer)

4950import qualified Network.Wai.Handler.Warp.Date as D

5051import qualified Network.Wai.Handler.Warp.FdCache as F

5152import Network.Wai.Handler.Warp.Header

@@ -268,7 +269,7 @@ sendRsp conn mfdc ver s0 hs0 (RspFile path mPart mRange isHead hook) = do

268269 hs = addAcceptRanges hs0

269270 s2 = H.status404

270271 hs2 = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0

271− body = fromByteString "File not found"

272+ body = byteString "File not found"

272273

273274----------------------------------------------------------------

274275

@@ -287,7 +288,7 @@ sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

287288sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

288289 header <- composeHeaderBuilder ver s hs needsChunked

289290 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

290− $ toBlazeBuffer (connWriteBuffer conn) (connBufferSize conn)

291+ $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

291292 let send builder = do

292293 popper <- recv builder

293294 let loop = do

@@ -448,6 +449,6 @@ replaceHeader k v hdrs = (k,v) : deleteBy ((==) `on` fst) (k,v) hdrs

448449

449450composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder

450451composeHeaderBuilder ver s hs True =

451− fromByteString <$> composeHeader ver s (addTransferEncoding hs)

452+ byteString <$> composeHeader ver s (addTransferEncoding hs)

452453composeHeaderBuilder ver s hs False =

453− fromByteString <$> composeHeader ver s hs

454+ byteString <$> composeHeader ver s hs

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

@@ -4,13 +4,12 @@

55module Network.Wai.Handler.Warp.Settings where

7−import Blaze.ByteString.Builder (copyByteString)

8−import Blaze.ByteString.Builder.Char.Utf8 (fromShow)

97import Control.Concurrent (forkIOWithUnmask)

108import Control.Exception

119import Control.Monad (when, void)

1210import Data.ByteString (ByteString)

1311import qualified Data.ByteString.Char8 as S8

12+import Data.ByteString.Builder (byteString)

1413#if __GLASGOW_HASKELL__ < 709

1514import Data.Monoid (mappend)

1615#endif

@@ -162,5 +161,7 @@ defaultOnExceptionResponse e

162161--

163162-- Since: 2.0.3.2

164163exceptionResponseForDebug :: SomeException -> Response

165−exceptionResponseForDebug e = responseBuilder H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")]

166− $ copyByteString "Exception: " `mappend` fromShow e

164+exceptionResponseForDebug e =

165+ responseBuilder H.internalServerError500

166+ [(H.hContentType, "text/plain; charset=utf-8")]

167+ $ byteString . S8.pack $ "Exception: " ++ show e

warp/test/RunSpec.hs+11−11

@@ -5,29 +5,29 @@

55module RunSpec (main, spec, withApp) where

77import Control.Concurrent (forkIO, killThread, threadDelay)

8+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

9+import qualified Control.Exception as E

10+import Control.Exception.Lifted (bracket, try, IOException, onException)

811import Control.Monad (forM_, replicateM_, unless)

9−import System.Timeout (timeout)

1012import Control.Monad.IO.Class (MonadIO, liftIO)

1113import Data.ByteString (ByteString, hPutStr, hGetSome)

12−import qualified Control.Exception as E

1314import qualified Data.ByteString as S

15+import Data.ByteString.Builder (byteString)

1416import qualified Data.ByteString.Char8 as S8

1517import qualified Data.ByteString.Lazy as L

1618import qualified Data.IORef as I

19+import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv)

1720import Network (connectTo, PortID (PortNumber))

21+import qualified Network.HTTP as HTTP

1822import Network.HTTP.Types

23+import Network.Socket (sClose)

24+import Network.Socket.ByteString (sendAll)

1925import Network.Wai

2026import Network.Wai.Handler.Warp

2127import System.IO (hFlush, hClose)

2228import System.IO.Unsafe (unsafePerformIO)

29+import System.Timeout (timeout)

2330import Test.Hspec

24−import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

25−import Control.Exception.Lifted (bracket, try, IOException, onException)

26−import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv)

27−import Network.Socket (sClose)

28−import qualified Network.HTTP as HTTP

29−import Blaze.ByteString.Builder (fromByteString)

30−import Network.Socket.ByteString (sendAll)

3131

3232main :: IO ()

3333main = hspec spec

@@ -360,7 +360,7 @@ spec = do

360360 let loop = do

361361 bs <- requestBody req

362362 unless (S.null bs) $ do

363− write $ fromByteString bs

363+ write $ byteString bs

364364 loop

365365 loop

366366 withApp defaultSettings app $ \port -> do

@@ -373,7 +373,7 @@ spec = do

373373

374374 it "streaming response with length" $ do

375375 let app _ f = f $ responseStream status200 [("content-length", "20")] $ \write _ -> do

376− replicateM_ 4 $ write $ fromByteString "Hello"

376+ replicateM_ 4 $ write $ byteString "Hello"

377377 withApp defaultSettings app $ \port -> do

378378 Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

379379 HTTP.rspBody res `shouldBe` "HelloHelloHelloHello"

warp/warp.cabal+4−16

@@ -30,16 +30,13 @@ Flag warp-debug

3030 Description: print debug output. not suitable for production

3131 Default: False

3232

33−Flag use-bytestring-builder

34− description: Use bytestring-builder package

35− default: False

36−

3733Library

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

3935 , array

4036 , auto-update >= 0.1.1 && < 0.2

41− , blaze-builder >= 0.3.3 && < 0.5

37+ , blaze-builder >= 0.4

4238 , bytestring >= 0.9.1.4

39+ , bytestring-builder

4340 , case-insensitive >= 0.2

4441 , containers

4542 , ghc-prim

@@ -59,11 +56,6 @@ Library

5956 , network-bytestring >= 0.1.3 && < 0.1.4

6057 else

6158 Build-Depends: network >= 2.3

62− if flag(use-bytestring-builder)

63− Build-Depends: bytestring < 0.10.2.0

64− , bytestring-builder

65− else

66− Build-Depends: bytestring >= 0.10.2.0

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

6860 Network.Wai.Handler.Warp.Internal

6961 Other-modules: Network.Wai.Handler.Warp.Buffer

@@ -140,8 +132,9 @@ Test-Suite spec

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

141133 , array

142134 , auto-update

143− , blaze-builder >= 0.3.3 && < 0.5

135+ , blaze-builder >= 0.4

144136 , bytestring >= 0.9.1.4

137+ , bytestring-builder

145138 , case-insensitive >= 0.2

146139 , ghc-prim

147140 , HTTP

@@ -168,11 +161,6 @@ Test-Suite spec

168161 , containers

169162 , http2 >= 1.0.2

170163 , word8

171− if flag(use-bytestring-builder)

172− Build-Depends: bytestring < 0.10.2.0

173− , bytestring-builder

174− else

175− Build-Depends: bytestring >= 0.10.2.0

176164

177165 if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)

178166 Cpp-Options: -DSENDFILEFD