ee4877e · typeable/wai

git.iko.soy/typeable/wai

Using a connection buffer to send RspBuilder.

commitee4877ee0dc20083bfb67a018f5adcaf7b782536 authorKazu Yamamoto <kazu@iij.ad.jp> dateMon 6 Jan 2014, 11:48 (13 years ago) parent808ee2a

6 files changed+51−9

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Buffer.hs+3−2 warp/Network/Wai/Handler/Warp/IO.hs+35 warp/Network/Wai/Handler/Warp/Response.hs+7−3 warp/Network/Wai/Handler/Warp/Run.hs+2−2 warp/Network/Wai/Handler/Warp/Types.hs+3−2 warp/warp.cabal+1

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

@@ -7,9 +7,10 @@ import Foreign.Marshal.Alloc (mallocBytes, free)

77import Foreign.Ptr (Ptr, plusPtr)

99type Buffer = Ptr Word8

10+type BufSize = Int

1011

1112-- FIXME come up with good values here

12−bufferSize :: Int

13+bufferSize :: BufSize

1314bufferSize = 4096

1415

1516allocateBuffer :: Int -> IO Buffer

@@ -18,7 +19,7 @@ allocateBuffer = mallocBytes

1819freeBuffer :: Buffer -> IO ()

1920freeBuffer = free

2021

21−toBlazeBuffer :: Buffer -> Int -> IO B.Buffer

22+toBlazeBuffer :: Buffer -> BufSize -> IO B.Buffer

2223toBlazeBuffer ptr size = do

2324 fptr <- newForeignPtr_ ptr

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

warp/Network/Wai/Handler/Warp/IO.hsnew file+35

@@ -0,0 +1,35 @@

1+{-# LANGUAGE BangPatterns #-}

3+module Network.Wai.Handler.Warp.IO where

5+import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep)

6+import Data.ByteString.Internal (ByteString(..))

7+import Foreign.ForeignPtr (newForeignPtr_)

8+import Foreign.Ptr (plusPtr, minusPtr)

9+import Network.Wai.Handler.Warp.Buffer

10+

11+toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()

12+toBufIOWith buf !size io (Builder build) = loop firstStep

13+ where

14+ firstStep = build (buildStep finalStep)

15+ finalStep (BufRange p _) = return $ Done p ()

16+ bufRange = BufRange buf (buf `plusPtr` size)

17+ runIO ptr = toBS buf (ptr `minusPtr` buf) >>= io

18+ loop step = do

19+ signal <- runBuildStep step bufRange

20+ case signal of

21+ Done ptr _ -> runIO ptr

22+ BufferFull minSize ptr next

23+ | size < minSize -> error "toBufIOWith: BufferFull: minSize"

24+ | otherwise -> do

25+ runIO ptr

26+ loop next

27+ InsertByteString ptr bs next -> do

28+ runIO ptr

29+ io bs

30+ loop next

31+

32+toBS :: Buffer -> Int -> IO ByteString

33+toBS ptr siz = do

34+ fptr <- newForeignPtr_ ptr

35+ return $ PS fptr 0 siz

warp/Network/Wai/Handler/Warp/Response.hs+7−3

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

1111 , defaultServerValue

1212 ) where

1313

14−import Blaze.ByteString.Builder (fromByteString, Builder, toByteStringIO, flush)

14+import Blaze.ByteString.Builder (fromByteString, Builder, flush)

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

1616import Control.Applicative

1717import Control.Exception

@@ -36,6 +36,8 @@ import qualified Network.HTTP.Types as H

3636import Network.Wai

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

3838import Network.Wai.Handler.Warp.Header

39+import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer)

40+import Network.Wai.Handler.Warp.IO (toBufIOWith)

3941import Network.Wai.Handler.Warp.ResponseHeader

4042import qualified Network.Wai.Handler.Warp.Timeout as T

4143import Network.Wai.Handler.Warp.Types

@@ -215,14 +217,16 @@ sendRsp conn ver s hs (RspBuilder body needsChunked) = do

215217 | needsChunked = header <> chunkedTransferEncoding body

216218 <> chunkedTransferTerminator

217219 | otherwise = header <> body

218− flip toByteStringIO hdrBdy $ connSendAll conn

220+ buffer = connBuffer conn

221+ size = connBufferSize conn

222+ toBufIOWith buffer size (connSendAll conn) hdrBdy

219223

220224----------------------------------------------------------------

221225

222226sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush $ \bodyFlush -> do

223227 header <- composeHeaderBuilder ver s hs needsChunked

224228 let src = yield header >> cbody bodyFlush

225− buffer = connBuffer conn

229+ buffer <- toBlazeBuffer (connBuffer conn) (connBufferSize conn)

226230 src $$ unsafeBuilderToByteString (return buffer) =$ connSink conn th

227231 where

228232 cbody bodyFlush = if needsChunked then body $= chunk else body

warp/Network/Wai/Handler/Warp/Run.hs+2−2

@@ -45,14 +45,14 @@ import Network.Socket (fdSocket)

4545socketConnection :: Socket -> IO Connection

4646socketConnection s = do

4747 buf <- allocateBuffer bufferSize

48− blazeBuf <- toBlazeBuffer buf bufferSize

4948 return Connection {

5049 connSendMany = Sock.sendMany s

5150 , connSendAll = Sock.sendAll s

5251 , connSendFile = defaultSendFile s

5352 , connClose = sClose s >> freeBuffer buf

5453 , connRecv = receive s buf bufferSize

55− , connBuffer = blazeBuf

54+ , connBuffer = buf

55+ , connBufferSize = bufferSize

5656 , connSendFileOverride = Override s

5757 }

5858

warp/Network/Wai/Handler/Warp/Types.hs+3−2

@@ -9,10 +9,10 @@ import Data.ByteString (ByteString)

99import Data.Typeable (Typeable)

1010import Network.HTTP.Types.Header

1111import Network.Socket (Socket)

12−import qualified Blaze.ByteString.Builder.Internal.Buffer as B (Buffer)

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

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

1514import qualified Network.Wai.Handler.Warp.Timeout as T

15+import Network.Wai.Handler.Warp.Buffer (Buffer,BufSize)

1616

1717----------------------------------------------------------------

1818

@@ -66,7 +66,8 @@ data Connection = Connection

6666 , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ filepath, offset, length, hook action, HTTP headers

6767 , connClose :: IO ()

6868 , connRecv :: IO ByteString

69− , connBuffer :: B.Buffer

69+ , connBuffer :: Buffer

70+ , connBufferSize :: BufSize

7071 , connSendFileOverride :: ConnSendFileOverride

7172 }

7273

warp/warp.cabal+1

@@ -59,6 +59,7 @@ Library

5959 Network.Wai.Handler.Warp.Date

6060 Network.Wai.Handler.Warp.FdCache

6161 Network.Wai.Handler.Warp.Header

62+ Network.Wai.Handler.Warp.IO

6263 Network.Wai.Handler.Warp.IORef

6364 Network.Wai.Handler.Warp.ReadInt

6465 Network.Wai.Handler.Warp.Recv