c43251b · typeable/wai

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

compare with master

unifiedsplit

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

7 , mallocBS

8 , newBufferPool

9 , withBufferPool

10− , toBlazeBuffer

10+ , toBuilderBuffer

11 , copy

12 , bufferIO

13 ) where

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

88-- Utilities

89--

90

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

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

92−toBlazeBuffer ptr size = do

92+toBuilderBuffer ptr size = do

93 fptr <- newForeignPtr_ ptr

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

95

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

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

3

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

5

6−import Blaze.ByteString.Builder (Builder)

6+import Data.ByteString.Builder (Builder)

7#if __GLASGOW_HASKELL__ < 709

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

9#endif

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

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

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

5

6import Data.ByteString (ByteString)

7+import Data.ByteString.Builder (Builder)

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

7import Network.Wai.Handler.Warp.Buffer

9import Network.Wai.Handler.Warp.Buffer

8import Network.Wai.Handler.Warp.Types

10import Network.Wai.Handler.Warp.Types

9

11

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−

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

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

21toBufIOWith buf !size io builder = loop firstWriter

13toBufIOWith buf !size io builder = loop firstWriter

22 where

14 where

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

35 runIO len

27 runIO len

36 io bs

28 io bs

37 loop next

29 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 (

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

19#endif

20

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

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

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

23#if __GLASGOW_HASKELL__ < 709

22#if __GLASGOW_HASKELL__ < 709

24import Control.Applicative

23import Control.Applicative

25#endif

24#endif

26import Control.Exception

25import Control.Exception

26+import Control.Monad (unless, when)

27import Data.Array ((!))

28import Data.ByteString (ByteString)

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

30import qualified Data.ByteString as S

29import 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)

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

33import qualified Data.CaseInsensitive as CI

34import Data.Function (on)

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

42#else

43import Data.Monoid (mappend, mempty)

44#endif

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

45import Data.Version (showVersion)

46import Data.Version (showVersion)

46import qualified Network.HTTP.Types as H

47import qualified Network.HTTP.Types as H

47import Network.Wai

48import Network.Wai

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

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

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

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

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

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

51import Network.Wai.Handler.Warp.Header

52import Network.Wai.Handler.Warp.Header

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

268 hs = addAcceptRanges hs0

269 hs = addAcceptRanges hs0

269 s2 = H.status404

270 s2 = H.status404

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

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

271− body = fromByteString "File not found"

272+ body = byteString "File not found"

272

273

273----------------------------------------------------------------

274----------------------------------------------------------------

274

275

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

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

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

288 header <- composeHeaderBuilder ver s hs needsChunked

289 header <- composeHeaderBuilder ver s hs needsChunked

289 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

290 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

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

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

291 let send builder = do

292 let send builder = do

292 popper <- recv builder

293 popper <- recv builder

293 let loop = do

294 let loop = do

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

448

449

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

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

450composeHeaderBuilder ver s hs True =

451composeHeaderBuilder ver s hs True =

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

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

452composeHeaderBuilder ver s hs False =

453composeHeaderBuilder 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 @@

4

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

6

7−import Blaze.ByteString.Builder (copyByteString)

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

9import Control.Concurrent (forkIOWithUnmask)

7import Control.Concurrent (forkIOWithUnmask)

10import Control.Exception

8import Control.Exception

11import Control.Monad (when, void)

9import Control.Monad (when, void)

12import Data.ByteString (ByteString)

10import Data.ByteString (ByteString)

13import qualified Data.ByteString.Char8 as S8

11import qualified Data.ByteString.Char8 as S8

12+import Data.ByteString.Builder (byteString)

14#if __GLASGOW_HASKELL__ < 709

13#if __GLASGOW_HASKELL__ < 709

15import Data.Monoid (mappend)

14import Data.Monoid (mappend)

16#endif

15#endif

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

162--

161--

163-- Since: 2.0.3.2

162-- Since: 2.0.3.2

164exceptionResponseForDebug :: SomeException -> Response

163exceptionResponseForDebug :: SomeException -> Response

164+exceptionResponseForDebug e =

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

165+ responseBuilder H.internalServerError500

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

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

5module RunSpec (main, spec, withApp) where

6

7import 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)

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

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

9−import System.Timeout (timeout)

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

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

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

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

12−import qualified Control.Exception as E

13import qualified Data.ByteString as S

14import qualified Data.ByteString as S

15+import Data.ByteString.Builder (byteString)

14import qualified Data.ByteString.Char8 as S8

16import qualified Data.ByteString.Char8 as S8

15import qualified Data.ByteString.Lazy as L

17import qualified Data.ByteString.Lazy as L

16import qualified Data.IORef as I

18import qualified Data.IORef as I

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

17import Network (connectTo, PortID (PortNumber))

20import Network (connectTo, PortID (PortNumber))

21+import qualified Network.HTTP as HTTP

18import Network.HTTP.Types

22import Network.HTTP.Types

23+import Network.Socket (sClose)

24+import Network.Socket.ByteString (sendAll)

19import Network.Wai

25import Network.Wai

20import Network.Wai.Handler.Warp

26import Network.Wai.Handler.Warp

21import System.IO (hFlush, hClose)

27import System.IO (hFlush, hClose)

22import System.IO.Unsafe (unsafePerformIO)

28import System.IO.Unsafe (unsafePerformIO)

29+import System.Timeout (timeout)

23import Test.Hspec

30import 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)

31

32main :: IO ()

33main = hspec spec

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

360 let loop = do

361 bs <- requestBody req

362 unless (S.null bs) $ do

363− write $ fromByteString bs

363+ write $ byteString bs

364 loop

365 loop

366 withApp defaultSettings app $ \port -> do

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

373

374 it "streaming response with length" $ do

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

376− replicateM_ 4 $ write $ fromByteString "Hello"

376+ replicateM_ 4 $ write $ byteString "Hello"

377 withApp defaultSettings app $ \port -> do

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

379 HTTP.rspBody res `shouldBe` "HelloHelloHelloHello"

warp/warp.cabal+4−16

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

30 Description: print debug output. not suitable for production

31 Default: False

32

33−Flag use-bytestring-builder

34− description: Use bytestring-builder package

35− default: False

36−

37Library

33Library

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

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

39 , array

35 , array

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

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

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

37+ , blaze-builder >= 0.4

42 , bytestring >= 0.9.1.4

38 , bytestring >= 0.9.1.4

39+ , bytestring-builder

43 , case-insensitive >= 0.2

40 , case-insensitive >= 0.2

44 , containers

41 , containers

45 , ghc-prim

42 , ghc-prim

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

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

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

60 else

57 else

61 Build-Depends: network >= 2.3

58 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

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

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

68 Network.Wai.Handler.Warp.Internal

60 Network.Wai.Handler.Warp.Internal

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

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

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

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

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

141 , array

133 , array

142 , auto-update

134 , auto-update

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

135+ , blaze-builder >= 0.4

144 , bytestring >= 0.9.1.4

136 , bytestring >= 0.9.1.4

137+ , bytestring-builder

145 , case-insensitive >= 0.2

138 , case-insensitive >= 0.2

146 , ghc-prim

139 , ghc-prim

147 , HTTP

140 , HTTP

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

168 , containers

161 , containers

169 , http2 >= 1.0.2

162 , http2 >= 1.0.2

170 , word8

163 , 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

176

164

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

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

178 Cpp-Options: -DSENDFILEFD

166 Cpp-Options: -DSENDFILEFD