on master help sign in
Reuse buffer for streaming responses #198
commitced80b8b24af312d0e8d408045c800f3b68e8fab authorMichael Snoyman <michael@snoyman.com> dateFri 15 Nov 2013, 06:02 (13 years ago) parent8b987e5
3 files changed+18−9
warp/Network/Wai/Handler/Warp/Recv.hs+5 warp/Network/Wai/Handler/Warp/Response.hs+13−5 warp/Network/Wai/Handler/Warp/Run.hs−4
warp/Network/Wai/Handler/Warp/Recv.hs+5
@@ -7,6 +7,7 @@ module Network.Wai.Handler.Warp.Recv (
77 , receive
88 , allocateRecvBuffer
99 , freeRecvBuffer
10+ , bytesPerRead
1011 ) where
1112
1213import Control.Applicative ((<$>))
@@ -61,6 +62,10 @@ receiveloop sock buf size = do
6162 else
6263 return bytes
6364
65+-- FIXME come up with good values here
66+bytesPerRead :: Int
67+bytesPerRead = 4096
68+
6469-- fixme: the type of the return value
6570foreign import ccall unsafe "recv"
6671 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
warp/Network/Wai/Handler/Warp/Response.hs+13−5
@@ -12,6 +12,9 @@ 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)
1518import Control.Applicative
1619import Control.Exception
1720import Control.Monad.IO.Class (liftIO)
@@ -20,7 +23,7 @@ import Data.ByteString (ByteString)
2023import qualified Data.ByteString.Char8 as B (pack)
2124import qualified Data.CaseInsensitive as CI
2225import Data.Conduit
23−import Data.Conduit.Blaze (builderToByteString)
26+import Data.Conduit.Blaze (unsafeBuilderToByteString)
2427import qualified Data.Conduit.List as CL
2528import Data.Function (on)
2629import Data.List (deleteBy)
@@ -33,6 +36,7 @@ import Network.Wai
3336import qualified Network.Wai.Handler.Warp.Date as D
3437import Network.Wai.Handler.Warp.Header
3538import Network.Wai.Handler.Warp.ResponseHeader
39+import Network.Wai.Handler.Warp.Recv
3640import qualified Network.Wai.Handler.Warp.Timeout as T
3741import Network.Wai.Handler.Warp.Types
3842import Network.Wai.Internal
@@ -212,8 +216,14 @@ sendRsp conn ver s hs (RspBuilder b needsChunked) = do
212216
213217sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush $ \bodyFlush -> do
214218 header <- composeHeaderBuilder ver s hs needsChunked
215− let src = CL.sourceList [header] `mappend` cbody bodyFlush
216− src $$ builderToByteString =$ connSink conn th
219+ let src = yield header >> cbody bodyFlush
220+ bracket (allocateRecvBuffer bytesPerRead) freeRecvBuffer $ \ptr -> do
221+ fptr <- newForeignPtr_ ptr
222+ let buffer = Buffer fptr
223+ ptr
224+ ptr
225+ (ptr `plusPtr` bytesPerRead)
226+ src $$ unsafeBuilderToByteString (return buffer) =$ connSink conn th
217227 where
218228 cbody bodyFlush = if needsChunked then body $= chunk else body
219229 where
@@ -221,8 +231,6 @@ sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush
221231 Flush -> flush
222232 Chunk builder -> builder)
223233 bodyFlush
224− -- FIXME perhaps alloca a buffer per thread and reuse that in all
225− -- functions below. Should lessen greatly the GC burden (I hope)
226234 chunk :: Conduit Builder IO Builder
227235 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
228236
warp/Network/Wai/Handler/Warp/Run.hs−4
@@ -40,10 +40,6 @@ import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
4040import Network.Socket (fdSocket)
4141#endif
4242
43−-- FIXME come up with good values here
44−bytesPerRead :: Int
45−bytesPerRead = 4096
46−
4743-- | Default action value for 'Connection'.
4844socketConnection :: Socket -> IO Connection
4945socketConnection s = do