on master help sign in
don't expose an internal bytestring.
commit1c9bb1ebf64a9537d42ff23fa01629639f1b4272 authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 10 Jul 2015, 10:28 (11 years ago) parentfee2e35
3 files changed+11−16
warp/Network/Wai/Handler/Warp/Buffer.hs+4−5 warp/Network/Wai/Handler/Warp/IO.hs+1−1 warp/Network/Wai/Handler/Warp/SendFile.hs+6−10
warp/Network/Wai/Handler/Warp/Buffer.hs+4−5
@@ -9,7 +9,7 @@ module Network.Wai.Handler.Warp.Buffer (
99 , withBufferPool
1010 , toBlazeBuffer
1111 , copy
12− , toBS
12+ , bufferIO
1313 ) where
1414
1515import Control.Monad (when)
@@ -102,8 +102,7 @@ copy !ptr (PS fp o l) = withForeignPtr fp $ \p -> do
102102 return $! ptr `plusPtr` l
103103{-# INLINE copy #-}
104104
105−{-# INLINE toBS #-}
106−toBS :: Buffer -> Int -> IO ByteString
107−toBS ptr siz = do
105+bufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO ()
106+bufferIO ptr siz io = do
108107 fptr <- newForeignPtr_ ptr
109− return $ PS fptr 0 siz
108+ io $ PS fptr 0 siz
warp/Network/Wai/Handler/Warp/IO.hs+1−1
@@ -21,7 +21,7 @@ toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()
2121toBufIOWith buf !size io builder = loop firstWriter
2222 where
2323 firstWriter = runBuilder builder
24− runIO len = toBS buf len >>= io
24+ runIO len = bufferIO buf len io
2525 loop writer = do
2626 (len, signal) <- writer buf size
2727 case signal of
warp/Network/Wai/Handler/Warp/SendFile.hs+6−10
@@ -68,8 +68,7 @@ packHeader buf siz send hook (bs:bss) n
6868 let dst = buf `plusPtr` n
6969 (bs1, bs2) = BS.splitAt room bs
7070 void $ copy dst bs1
71− entire <- toBS buf siz
72− send entire
71+ bufferIO buf siz send
7372 hook
7473 packHeader buf siz send hook (bs2:bss) 0
7574 where
@@ -95,10 +94,9 @@ readSendFile buf siz send fid off0 len0 hook headers = do
9594 IO.withBinaryFile path IO.ReadMode $ \h -> do
9695 IO.hSeek h IO.AbsoluteSeek off0
9796 n <- IO.hGetBufSome h buf' (mini room len0)
98− bs <- toBS buf (hn + n)
99− let n' = fromIntegral n
100− send bs
97+ bufferIO buf (hn + n) send
10198 hook
99+ let n' = fromIntegral n
102100 fptr <- newForeignPtr_ buf
103101 loop h fptr (len0 - n')
104102 where
@@ -121,10 +119,9 @@ readSendFile buf siz send fid off0 len0 hook headers =
121119 let room = siz - hn
122120 buf' = buf `plusPtr` hn
123121 n <- positionRead fd buf' (mini room len0) off0
124− bs <- toBS buf (hn + n)
125− let n' = fromIntegral n
126− send bs
122+ bufferIO buf (hn + n) send
127123 hook
124+ let n' = fromIntegral n
128125 loop fd (len0 - n') (off0 + n')
129126 where
130127 path = fileIdPath fid
@@ -138,9 +135,8 @@ readSendFile buf siz send fid off0 len0 hook headers =
138135 | len <= 0 = return ()
139136 | otherwise = do
140137 n <- positionRead fd buf (mini siz len) off
141− bs <- toBS buf n
138+ bufferIO buf n send
142139 let n' = fromIntegral n
143− send bs
144140 hook
145141 loop fd (len - n') (off + n')
146142