db94f79 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge branch 'buffer' into 'kazu-master'.

db94f79Kazu Yamamoto11 years ago

warp-tls/Network/Wai/Handler/WarpTLS.hs+3−6

compare with master

unifiedsplit

@@ -272,10 +272,9 @@ httpOverTls TLSSettings{..} s cachedRef params = do

272 ctx <- TLS.contextNew backend params gen

273 TLS.contextHookSetLogging ctx tlsLogging

274 TLS.handshake ctx

275− readBuf <- allocateBuffer bufferSize

276 writeBuf <- allocateBuffer bufferSize

275 writeBuf <- allocateBuffer bufferSize

277 tls <- getTLSinfo ctx

276 tls <- getTLSinfo ctx

278− return (conn ctx readBuf writeBuf, tls)

277+ return (conn ctx writeBuf, tls)

279 where

278 where

280 backend = TLS.Backend {

279 backend = TLS.Backend {

281 TLS.backendFlush = return ()

280 TLS.backendFlush = return ()

@@ -283,14 +282,13 @@ httpOverTls TLSSettings{..} s cachedRef params = do

283 , TLS.backendSend = sendAll s

282 , TLS.backendSend = sendAll s

284 , TLS.backendRecv = recvTLS cachedRef s

283 , TLS.backendRecv = recvTLS cachedRef s

285 }

284 }

286− conn ctx readBuf writeBuf = Connection {

285+ conn ctx writeBuf = Connection {

287 connSendMany = TLS.sendData ctx . L.fromChunks

286 connSendMany = TLS.sendData ctx . L.fromChunks

288 , connSendAll = TLS.sendData ctx . L.fromChunks . return

287 , connSendAll = TLS.sendData ctx . L.fromChunks . return

289 , connSendFile = sendfile

288 , connSendFile = sendfile

290 , connClose = close

289 , connClose = close

291 , connRecv = recv

290 , connRecv = recv

292 , connSendFileOverride = NotOverride

291 , connSendFileOverride = NotOverride

293− , connReadBuffer = readBuf

294 , connWriteBuffer = writeBuf

292 , connWriteBuffer = writeBuf

295 , connBufferSize = bufferSize

293 , connBufferSize = bufferSize

296 }

294 }

@@ -310,8 +308,7 @@ httpOverTls TLSSettings{..} s cachedRef params = do

310 void $ tickle' -- This tickles the Timer. It MUST be called per chunk.

308 void $ tickle' -- This tickles the Timer. It MUST be called per chunk.

311 loop h $ remaining - B.length x

309 loop h $ remaining - B.length x

312

310

313− close = freeBuffer readBuf `finally`

314− freeBuffer writeBuf `finally`

311+ close = freeBuffer writeBuf `finally`

315 void (tryIO $ TLS.bye ctx) `finally`

312 void (tryIO $ TLS.bye ctx) `finally`

316 TLS.contextClose ctx

313 TLS.contextClose ctx

317

314

warp/Network/Wai/Handler/Warp/Buffer.hs+61−5

@@ -1,17 +1,73 @@

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

3+import Control.Monad (when)

3import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..))

4import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..))

4import Data.Word (Word8)

5import Data.Word (Word8)

6+import Data.IORef (IORef, newIORef, readIORef, writeIORef)

7+import Data.ByteString (ByteString, empty, length)

8+import Data.ByteString.Internal (ByteString(PS), mallocByteString)

9+import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)

5−import Foreign.ForeignPtr (newForeignPtr_)

10+import Foreign.ForeignPtr (newForeignPtr, newForeignPtr_, withForeignPtr)

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

11+import Foreign.Marshal.Alloc (mallocBytes, free, finalizerFree)

7−import Foreign.Ptr (Ptr, plusPtr)

12+import Foreign.Ptr (Ptr, castPtr, plusPtr)

13+

14+largeBufferSize :: Int

15+largeBufferSize = 16384

16+minBufferSize :: Int

17+minBufferSize = 2048

18+

19+type BufferPool = IORef ByteString

20+

21+newBufferPool :: IO BufferPool

22+newBufferPool = newIORef Data.ByteString.empty

23+

24+mallocBuffer :: Int -> IO ByteString

25+mallocBuffer size = do

26+ ptr <- mallocBytes size

27+ fptr <- newForeignPtr finalizerFree ptr

28+ return $! PS fptr 0 size

29+{-# INLINE mallocBuffer #-}

30+

31+createBuffer :: Int -> IO ByteString

32+createBuffer size = do

33+ fptr <- mallocByteString size

34+ return $! PS fptr 0 size

35+{-# INLINE createBuffer #-}

36+

37+usefulBuffer :: ByteString -> Bool

38+usefulBuffer buffer = Data.ByteString.length buffer >= minBufferSize

39+{-# INLINE usefulBuffer #-}

40+

41+getBuffer :: BufferPool -> IO ByteString

42+getBuffer pool = do

43+ buffer <- readIORef pool

44+ if usefulBuffer buffer then return buffer else mallocBuffer largeBufferSize

45+{-# INLINE getBuffer #-}

46+

47+putBuffer :: BufferPool -> ByteString -> IO ()

48+putBuffer pool buffer = when (usefulBuffer buffer) $ writeIORef pool buffer

49+{-# INLINE putBuffer #-}

50+

51+withForeignBuffer :: ByteString -> ((Ptr Word8, Int) -> IO Int) -> IO Int

52+withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s, l)

53+{-# INLINE withForeignBuffer #-}

54+

55+withBufferPool :: BufferPool -> ((Ptr Word8, Int) -> IO Int) -> IO ByteString

56+withBufferPool pool f = do

57+ buffer <- getBuffer pool

58+ consumed <- withForeignBuffer buffer f

59+ putBuffer pool $! unsafeDrop consumed buffer

60+ return $! unsafeTake consumed buffer

61+{-# INLINE withBufferPool #-}

9type Buffer = Ptr Word8

63type Buffer = Ptr Word8

10type BufSize = Int

64type BufSize = Int

12−-- FIXME come up with good values here

66+-- 2^14 = 1024 * 16

67+-- The maximum size of TLS record

68+-- The maximum size of HTTP/2 frame payload (excluding frame header)

13bufferSize :: BufSize

69bufferSize :: BufSize

14−bufferSize = 4096

70+bufferSize = 16384

16allocateBuffer :: Int -> IO Buffer

72allocateBuffer :: Int -> IO Buffer

17allocateBuffer = mallocBytes

73allocateBuffer = mallocBytes

warp/Network/Wai/Handler/Warp/Recv.hs+12−30

@@ -8,18 +8,15 @@ module Network.Wai.Handler.Warp.Recv (

8#if __GLASGOW_HASKELL__ < 709

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

10#endif

11−import Control.Monad (void)

12−import qualified Data.ByteString as BS (empty)

11+import Data.ByteString (ByteString)

13−import Data.ByteString.Internal (ByteString(..), mallocByteString)

14import Data.Word (Word8)

12import Data.Word (Word8)

15import Foreign.C.Error (eAGAIN, getErrno, throwErrno)

13import Foreign.C.Error (eAGAIN, getErrno, throwErrno)

16import Foreign.C.Types

14import Foreign.C.Types

17−import Foreign.ForeignPtr (withForeignPtr)

18import Foreign.Ptr (Ptr, castPtr)

15import Foreign.Ptr (Ptr, castPtr)

19import GHC.Conc (threadWaitRead)

16import GHC.Conc (threadWaitRead)

20import Network.Socket (Socket, fdSocket)

17import Network.Socket (Socket, fdSocket)

21−import System.Posix.Types (Fd(..))

22import Network.Wai.Handler.Warp.Buffer

18import Network.Wai.Handler.Warp.Buffer

19+import System.Posix.Types (Fd(..))

24#ifdef mingw32_HOST_OS

21#ifdef mingw32_HOST_OS

25import GHC.IO.FD (FD(..), readRawBufferPtr)

22import GHC.IO.FD (FD(..), readRawBufferPtr)

@@ -28,37 +25,25 @@ import Network.Wai.Handler.Warp.Windows

29----------------------------------------------------------------

26----------------------------------------------------------------

31−receive :: Socket -> Buffer -> Int -> IO ByteString

28+receive :: Socket -> BufferPool -> IO ByteString

32−receive sock buf size = do

29+receive sock pool = withBufferPool pool $ \ (ptr, size) -> do

33− bytes <- fromIntegral <$> receiveloop sock' buf' size'

34− if bytes == 0 then

35− return BS.empty

36− else do

37− fptr <- mallocByteString bytes

38− void $ withForeignPtr fptr $ \ptr ->

39− c_memcpy ptr buf (fromIntegral bytes)

40− return $! PS fptr 0 bytes

41− where

42− sock' = fdSocket sock

30+ let sock' = fdSocket sock

43− buf' = castPtr buf

31+ size' = fromIntegral size

44− size' = fromIntegral size

32+ received <- fromIntegral <$> receiveloop sock' ptr size'

33+ return received

46−#ifdef mingw32_HOST_OS

47receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt

35receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt

48−#else

49−receiveloop :: CInt -> Ptr CChar -> CSize -> IO CInt

50−#endif

51−receiveloop sock buf size = do

36+receiveloop sock ptr size = do

52#ifdef mingw32_HOST_OS

37#ifdef mingw32_HOST_OS

53− bytes <- windowsThreadBlockHack $ fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) buf 0 size

38+ bytes <- windowsThreadBlockHack $ fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) (castPtr ptr) 0 size

54#else

39#else

55− bytes <- c_recv sock buf size 0

40+ bytes <- c_recv sock (castPtr ptr) size 0

56#endif

41#endif

57 if bytes == -1 then do

42 if bytes == -1 then do

58 errno <- getErrno

43 errno <- getErrno

59 if errno == eAGAIN then do

44 if errno == eAGAIN then do

60 threadWaitRead (Fd sock)

45 threadWaitRead (Fd sock)

61− receiveloop sock buf size

46+ receiveloop sock ptr size

62 else

47 else

63 throwErrno "receiveloop"

48 throwErrno "receiveloop"

64 else

49 else

@@ -67,6 +52,3 @@ receiveloop sock buf size = do

67-- fixme: the type of the return value

52-- fixme: the type of the return value

68foreign import ccall unsafe "recv"

53foreign import ccall unsafe "recv"

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

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

70−

71−foreign import ccall unsafe "string.h memcpy"

72− c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

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

@@ -48,15 +48,15 @@ import Network.Socket (fdSocket)

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

49socketConnection :: Socket -> IO Connection

50socketConnection s = do

51− readBuf <- allocateBuffer bufferSize

51+ bufferPool <- newBufferPool

52 writeBuf <- allocateBuffer bufferSize

53 return Connection {

54 connSendMany = Sock.sendMany s

55 , connSendAll = Sock.sendAll s

56 , connSendFile = defaultSendFile s

57− , connClose = sClose s >> freeBuffer readBuf >> freeBuffer writeBuf

57+ , connClose = sClose s >> freeBuffer writeBuf

58− , connRecv = receive s readBuf bufferSize

58+ , connRecv = receive s bufferPool

59− , connReadBuffer = readBuf

59+ , connBufferPool = bufferPool

60 , connWriteBuffer = writeBuf

61 , connBufferSize = bufferSize

62 , connSendFileOverride = Override s

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

@@ -12,7 +12,7 @@ import Data.Typeable (Typeable)

12import Data.Word (Word16)

13import Network.HTTP.Types.Header

14import Network.Socket (Socket)

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

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

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

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

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

@@ -79,9 +79,9 @@ data Connection = Connection

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

80 , connClose :: IO ()

81 , connRecv :: IO ByteString

82− , connReadBuffer :: Buffer

82+ , connBufferPool :: BufferPool

83 , connWriteBuffer :: Buffer

84− , connBufferSize :: BufSize

84+ , connBufferSize :: BufSize -- ^ The size of 'connWriteBuffer'

85 , connSendFileOverride :: ConnSendFileOverride

86 }