06355b1 · typeable/wai

git.iko.soy/typeable/wai

Making a write buffer "per connection".

commit06355b1f9311489be358fbf9d4feaecb83c5da51 authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 15 Nov 2013, 18:13 (13 years ago) parent25c6bc3

6 files changed+43−34

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Buffer.hs+27 warp/Network/Wai/Handler/Warp/Recv.hs+3−19 warp/Network/Wai/Handler/Warp/Response.hs+2−11 warp/Network/Wai/Handler/Warp/Run.hs+7−3 warp/Network/Wai/Handler/Warp/Types.hs+2 warp/warp.cabal+2−1

warp/Network/Wai/Handler/Warp/Buffer.hsnew file+27

@@ -0,0 +1,27 @@

1+module Network.Wai.Handler.Warp.Buffer where

3+import qualified Blaze.ByteString.Builder.Internal.Buffer as B (Buffer (..))

4+import Data.Word (Word8)

5+import Foreign.ForeignPtr (newForeignPtr_)

6+import Foreign.Marshal.Alloc (mallocBytes, free)

7+import Foreign.Ptr (Ptr, plusPtr)

9+type Buffer = Ptr Word8

10+

11+-- FIXME come up with good values here

12+bytesPerRead :: Int

13+bytesPerRead = 4096

14+

15+bytesPerWrite :: Int

16+bytesPerWrite = 4096

17+

18+allocateBuffer :: Int -> IO Buffer

19+allocateBuffer = mallocBytes

20+

21+freeBuffer :: Buffer -> IO ()

22+freeBuffer = free

23+

24+toBlazeBuffer :: Buffer -> Int -> IO B.Buffer

25+toBlazeBuffer ptr size = do

26+ fptr <- newForeignPtr_ ptr

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

warp/Network/Wai/Handler/Warp/Recv.hs+3−19

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

33-- fixme: windows support

55module Network.Wai.Handler.Warp.Recv (

6− ReceiveBuffer

7− , receive

8− , allocateRecvBuffer

9− , freeRecvBuffer

10− , bytesPerRead

6+ receive

117 ) where

128

139import Control.Applicative ((<$>))

@@ -22,19 +18,11 @@ import Foreign.Ptr (Ptr, castPtr)

2218import GHC.Conc (threadWaitRead)

2319import Network.Socket (Socket, fdSocket)

2420import System.Posix.Types (Fd(..))

25−import Foreign.Marshal.Alloc (mallocBytes, free)

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

2622

2723----------------------------------------------------------------

2824

29−type ReceiveBuffer = Ptr Word8

30−

31−allocateRecvBuffer :: Int -> IO ReceiveBuffer

32−allocateRecvBuffer = mallocBytes

33−

34−freeRecvBuffer :: ReceiveBuffer -> IO ()

35−freeRecvBuffer = free

36−

37−receive :: Socket -> ReceiveBuffer -> Int -> IO ByteString

25+receive :: Socket -> Buffer -> Int -> IO ByteString

3826receive sock buf size = do

3927 bytes <- fromIntegral <$> receiveloop sock' buf' size'

4028 if bytes == 0 then

@@ -62,10 +50,6 @@ receiveloop sock buf size = do

6250 else

6351 return bytes

6452

65−-- FIXME come up with good values here

66−bytesPerRead :: Int

67−bytesPerRead = 4096

68−

6953-- fixme: the type of the return value

7054foreign import ccall unsafe "recv"

7155 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

warp/Network/Wai/Handler/Warp/Response.hs+2−11

@@ -12,9 +12,6 @@ module Network.Wai.Handler.Warp.Response (

1212

1313import Blaze.ByteString.Builder (fromByteString, Builder, toByteStringIO, flush)

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

15−import Blaze.ByteString.Builder.Internal.Buffer (Buffer (..))

16−import Foreign.ForeignPtr (newForeignPtr_)

17−import Foreign.Ptr (plusPtr)

1815import Control.Applicative

1916import Control.Exception

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

@@ -35,7 +32,6 @@ import Network.Wai

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

3633import Network.Wai.Handler.Warp.Header

3734import Network.Wai.Handler.Warp.ResponseHeader

38−import Network.Wai.Handler.Warp.Recv

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

4036import Network.Wai.Handler.Warp.Types

4137import Network.Wai.Internal

@@ -216,13 +212,8 @@ sendRsp conn ver s hs (RspBuilder b needsChunked) = do

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

217213 header <- composeHeaderBuilder ver s hs needsChunked

218214 let src = yield header >> cbody bodyFlush

219− bracket (allocateRecvBuffer bytesPerRead) freeRecvBuffer $ \ptr -> do

220− fptr <- newForeignPtr_ ptr

221− let buffer = Buffer fptr

222− ptr

223− ptr

224− (ptr `plusPtr` bytesPerRead)

225− src $$ unsafeBuilderToByteString (return buffer) =$ connSink conn th

215+ buffer = connWriteBuffer conn

216+ src $$ unsafeBuilderToByteString (return buffer) =$ connSink conn th

226217 where

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

228219 where

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

@@ -22,6 +22,7 @@ import qualified Network.Socket.ByteString as Sock

2222import Network.Wai

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

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

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

2526import Network.Wai.Handler.Warp.Header

2627import Network.Wai.Handler.Warp.Recv

2728import Network.Wai.Handler.Warp.Request

@@ -43,13 +44,16 @@ import Network.Socket (fdSocket)

4344-- | Default action value for 'Connection'.

4445socketConnection :: Socket -> IO Connection

4546socketConnection s = do

46− buf <- allocateRecvBuffer bytesPerRead

47+ rbuf <- allocateBuffer bytesPerRead

48+ wbuf <- allocateBuffer bytesPerWrite

49+ wBlazeBuf <- toBlazeBuffer wbuf bytesPerWrite

4750 return Connection {

4851 connSendMany = Sock.sendMany s

4952 , connSendAll = Sock.sendAll s

5053 , connSendFile = defaultSendFile s

51− , connClose = sClose s >> freeRecvBuffer buf

52− , connRecv = receive s buf bytesPerRead

54+ , connClose = sClose s >> freeBuffer rbuf >> freeBuffer wbuf

55+ , connRecv = receive s rbuf bytesPerRead

56+ , connWriteBuffer = wBlazeBuf

5357 , connSendFileOverride = Override s

5458 }

5559

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

@@ -9,6 +9,7 @@ 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)

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

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

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

@@ -65,6 +66,7 @@ data Connection = Connection

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

6667 , connClose :: IO ()

6768 , connRecv :: IO ByteString

69+ , connWriteBuffer :: B.Buffer

6870 , connSendFileOverride :: ConnSendFileOverride

6971 }

7072

warp/warp.cabal+2−1

@@ -54,7 +54,8 @@ Library

5454 Build-Depends: network >= 2.3

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

5656 Network.Wai.Handler.Warp.Timeout

57− Other-modules: Network.Wai.Handler.Warp.Conduit

57+ Other-modules: Network.Wai.Handler.Warp.Buffer

58+ Network.Wai.Handler.Warp.Conduit

5859 Network.Wai.Handler.Warp.Date

5960 Network.Wai.Handler.Warp.FdCache

6061 Network.Wai.Handler.Warp.Header