recv-0.1.1/0000755000000000000000000000000007346545000010641 5ustar0000000000000000recv-0.1.1/ChangeLog.md0000644000000000000000000000024507346545000013013 0ustar0000000000000000# ChangeLog for "recv" ## v0.1.1 * Fixing the bug that the last chunk is skipped when the size is insufficient [1031](https://github.com/yesodweb/wai/pull/1031) recv-0.1.1/LICENSE0000644000000000000000000000276607346545000011661 0ustar0000000000000000Copyright (c) 2022, Internet Initiative Japan Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. recv-0.1.1/Network/Socket/0000755000000000000000000000000007346545000013522 5ustar0000000000000000recv-0.1.1/Network/Socket/BufferPool.hs0000644000000000000000000000264307346545000016126 0ustar0000000000000000-- | This module provides efficient receiving functions from the network. -- 'Network.Socket.ByteString.recv' uses 'createAndTrim' -- which behaves as follows: -- -- * Allocates a buffer whose size is decided from the -- first argument. -- * Receives data with the buffer. -- * Allocates another buffer whose size fits the received data. -- * Copies the data from the first buffer to the second buffer. -- -- On 64bit machines, the global lock is taken for the allocation of -- a byte string whose length is larger than or equal to 3272 bytes. -- So, for instance, if 4,096 is specified to 'recv' and the size of -- received data is 3,300, the global lock is taken twice with the copy -- overhead. -- -- The efficient receiving functions provided here use a buffer pool. -- A large buffer is allocated at the beginning and it is divided into -- a used one and a leftover when receiving. -- The latter is kept in the buffer pool and will be used next time. -- When the buffer gets small -- and usefless, a new large buffer is allocated. module Network.Socket.BufferPool ( -- * Recv Recv, receive, BufferPool, newBufferPool, withBufferPool, -- * RecvN RecvN, makeRecvN, -- * Types Buffer, BufSize, -- * Utilities mallocBS, copy, ) where import Network.Socket.BufferPool.Buffer import Network.Socket.BufferPool.Recv import Network.Socket.BufferPool.Types recv-0.1.1/Network/Socket/BufferPool/0000755000000000000000000000000007346545000015565 5ustar0000000000000000recv-0.1.1/Network/Socket/BufferPool/Buffer.hs0000644000000000000000000000452107346545000017334 0ustar0000000000000000module Network.Socket.BufferPool.Buffer ( newBufferPool, withBufferPool, mallocBS, copy, ) where import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import Data.ByteString.Unsafe (unsafeDrop, unsafeTake) import Data.IORef (newIORef, readIORef, writeIORef) import Foreign.ForeignPtr import Foreign.Marshal.Alloc (finalizerFree, mallocBytes) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (castPtr, plusPtr) import Network.Socket.BufferPool.Types ---------------------------------------------------------------- -- | Creating a buffer pool. -- The first argument is the lower limit. -- When the size of the buffer in the poll is lower than this limit, -- the buffer is thrown awany (and is eventually freed). -- Then a new buffer is allocated. -- The second argument is the size for the new allocation. newBufferPool :: Int -> Int -> IO BufferPool newBufferPool l h = BufferPool l h <$> newIORef BS.empty ---------------------------------------------------------------- -- | Using a buffer pool. -- The second argument is a function which returns -- how many bytes are filled in the buffer. -- The buffer in the buffer pool is automatically managed. withBufferPool :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO ByteString withBufferPool (BufferPool l h ref) f = do buf0 <- readIORef ref buf <- if BS.length buf0 >= l then return buf0 else mallocBS h consumed <- withForeignBuffer buf f writeIORef ref $ unsafeDrop consumed buf return $ unsafeTake consumed buf withForeignBuffer :: ByteString -> (Buffer -> BufSize -> IO Int) -> IO Int withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s) l {-# INLINE withForeignBuffer #-} ---------------------------------------------------------------- -- | Allocating a byte string. mallocBS :: Int -> IO ByteString mallocBS size = do ptr <- mallocBytes size fptr <- newForeignPtr finalizerFree ptr return $ PS fptr 0 size {-# INLINE mallocBS #-} -- | Copying the bytestring to the buffer. -- This function returns the point where the next copy should start. copy :: Buffer -> ByteString -> IO Buffer copy ptr (PS fp o l) = withForeignPtr fp $ \p -> do copyBytes ptr (p `plusPtr` o) (fromIntegral l) return $ ptr `plusPtr` l {-# INLINE copy #-} recv-0.1.1/Network/Socket/BufferPool/Recv.hs0000644000000000000000000000654607346545000017033 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.Socket.BufferPool.Recv ( receive, makeRecvN, ) where import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..), unsafeCreate) import Data.IORef import Network.Socket (Socket, recvBuf) import Network.Socket.BufferPool.Buffer import Network.Socket.BufferPool.Types ---------------------------------------------------------------- -- | The receiving function with a buffer pool. -- The buffer pool is automatically managed. receive :: Socket -> BufferPool -> Recv receive sock pool = withBufferPool pool $ \ptr size -> recvBuf sock ptr size ---------------------------------------------------------------- -- | This function returns a receiving function -- based on two receiving functions. -- The returned function receives exactly N bytes. -- The first argument is an initial received data. -- After consuming the initial data, the two functions is used. -- When N is less than equal to 4096, the buffer pool is used. -- Otherwise, a new buffer is allocated. -- In this case, the global lock is taken. -- -- >>> :seti -XOverloadedStrings -- >>> tryRecvN "a" 3 =<< _iorefRecv ["bcd"] -- ("abc","d") -- >>> tryRecvN "a" 3 =<< _iorefRecv ["bc"] -- ("abc","") -- >>> tryRecvN "a" 3 =<< _iorefRecv ["b"] -- ("ab","") makeRecvN :: ByteString -> Recv -> IO RecvN makeRecvN bs0 recv = do ref <- newIORef bs0 return $ recvN ref recv -- | The receiving function which receives exactly N bytes -- (the fourth argument). recvN :: IORef ByteString -> Recv -> RecvN recvN ref recv size = do cached <- readIORef ref (bs, leftover) <- tryRecvN cached size recv writeIORef ref leftover return bs ---------------------------------------------------------------- tryRecvN :: ByteString -> Int -> IO ByteString -> IO (ByteString, ByteString) tryRecvN init0 siz0 recv | siz0 <= len0 = return $ BS.splitAt siz0 init0 | otherwise = go (init0 :) (siz0 - len0) where len0 = BS.length init0 go build left = do bs <- recv let len = BS.length bs if len == 0 then do let cs = concatN (siz0 - left) $ build [] return (cs, "") else if len >= left then do let (consume, leftover) = BS.splitAt left bs ret = concatN siz0 $ build [consume] return (ret, leftover) else do let build' = build . (bs :) left' = left - len go build' left' concatN :: Int -> [ByteString] -> ByteString -- Just because it's logical concatN _ [] = "" -- To avoid a copy if there's only one ByteString concatN _ [bs] = bs concatN total bss0 = unsafeCreate total $ \ptr -> goCopy bss0 ptr where goCopy [] _ = return () goCopy (bs : bss) ptr = do ptr' <- copy ptr bs goCopy bss ptr' -- | doctest only. Elements in the argument must not be empty. _iorefRecv :: [ByteString] -> IO (IO ByteString) _iorefRecv ini = do ref <- newIORef ini return $ recv ref where recv ref = do xxs <- readIORef ref case xxs of [] -> do writeIORef ref $ error "closed" return "" x : xs -> do writeIORef ref xs return x recv-0.1.1/Network/Socket/BufferPool/Types.hs0000644000000000000000000000137207346545000017230 0ustar0000000000000000module Network.Socket.BufferPool.Types where import Data.ByteString (ByteString) import Data.IORef import Data.Word (Word8) import Foreign.Ptr (Ptr) -- | Type for buffer. type Buffer = Ptr Word8 -- | Type for buffer size. type BufSize = Int -- | Type for read buffer pool. data BufferPool = BufferPool { minBufSize :: Int -- ^ If the buffer is larger than or equal to this size, -- the buffer is used. -- Otherwise, a new buffer is allocated. -- The thrown buffer is eventually freed. , maxBufSize :: Int , poolBuffer :: IORef ByteString } -- | Type for the receiving function with a buffer pool. type Recv = IO ByteString -- | Type for the receiving function which receives N bytes. type RecvN = Int -> IO ByteString recv-0.1.1/recv.cabal0000644000000000000000000000264607346545000012574 0ustar0000000000000000cabal-version: >=1.10 name: recv version: 0.1.1 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp author: Kazu Yamamoto stability: Stable homepage: http://github.com/yesodweb/wai synopsis: Efficient network recv description: Network recv based on buffer pools category: Network build-type: Simple extra-source-files: ChangeLog.md library exposed-modules: Network.Socket.BufferPool other-modules: Network.Socket.BufferPool.Buffer Network.Socket.BufferPool.Recv Network.Socket.BufferPool.Types default-language: Haskell2010 ghc-options: -Wall build-depends: base >=4.12 && <5, bytestring >=0.9.1.4, network >=3.1.0 if impl(ghc >=8) default-extensions: Strict StrictData test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs build-tool-depends: hspec-discover:hspec-discover hs-source-dirs: test . other-modules: BufferPoolSpec Network.Socket.BufferPool Network.Socket.BufferPool.Buffer Network.Socket.BufferPool.Recv Network.Socket.BufferPool.Types default-language: Haskell2010 ghc-options: -Wall build-depends: base >=4.12 && <5, bytestring >=0.9.1.4, network >=3.1.0, hspec recv-0.1.1/test/0000755000000000000000000000000007346545000011620 5ustar0000000000000000recv-0.1.1/test/BufferPoolSpec.hs0000644000000000000000000000274407346545000015041 0ustar0000000000000000module BufferPoolSpec where import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B (ByteString (PS)) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (plusPtr) import Network.Socket.BufferPool import Test.Hspec (Spec, describe, hspec, it, shouldBe) main :: IO () main = hspec spec -- Two ByteStrings each big enough to fill a buffer (16K). wantData, otherData :: B.ByteString wantData = B.replicate 16384 0xac otherData = B.replicate 16384 0x77 spec :: Spec spec = describe "withBufferPool" $ do it "does not clobber buffers" $ do pool <- newBufferPool 2048 16384 -- 'pool' contains B.empty; prime it to contain a real buffer. _ <- withBufferPool pool $ \_ _ -> return 0 -- 'pool' contains a 16K buffer; fill it with \xac and keep the result. got <- withBufferPool pool $ blitBuffer wantData got `shouldBe` wantData -- 'pool' should now be empty and reallocate, rather than clobber the -- previous buffer. _ <- withBufferPool pool $ blitBuffer otherData got `shouldBe` wantData -- Fill the Buffer with the contents of the ByteString and return the number of -- bytes written. To be used with 'withBufferPool'. blitBuffer :: B.ByteString -> Buffer -> BufSize -> IO Int blitBuffer (B.PS fp off len) dst len' = withForeignPtr fp $ \ptr -> do let src = ptr `plusPtr` off n = min len len' copyBytes dst src n return n recv-0.1.1/test/Spec.hs0000644000000000000000000000005407346545000013045 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}