recv 0.1.1 → 0.1.2
raw patch · 6 files changed
+105/−23 lines, 6 filesdep +recvdep ~networknew-uploader
Dependencies added: recv
Dependency ranges changed: network
Files
- ChangeLog.md +6/−1
- Network/Socket/BufferPool.hs +2/−0
- Network/Socket/BufferPool/Buffer.hs +26/−4
- Network/Socket/BufferPool/Recv.hs +12/−1
- recv.cabal +5/−4
- test/BufferPoolSpec.hs +54/−13
ChangeLog.md view
@@ -1,6 +1,11 @@ # ChangeLog for "recv" +## v0.1.2++* Providing `receiveNoWait` and `tryWithBufferPool`.+ [#1107](https://github.com/yesodweb/wai/pull/1107)+ ## 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)+ insufficient [#1031](https://github.com/yesodweb/wai/pull/1031)
Network/Socket/BufferPool.hs view
@@ -24,9 +24,11 @@ -- * Recv Recv, receive,+ receiveNoWait, BufferPool, newBufferPool, withBufferPool,+ tryWithBufferPool, -- * RecvN RecvN,
Network/Socket/BufferPool/Buffer.hs view
@@ -1,13 +1,13 @@ module Network.Socket.BufferPool.Buffer ( newBufferPool, withBufferPool,+ tryWithBufferPool, 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)@@ -32,17 +32,39 @@ -- | Using a buffer pool. -- The second argument is a function which returns -- how many bytes are filled in the buffer.+-- This function should return non negative 'Int'. -- The buffer in the buffer pool is automatically managed. withBufferPool :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO ByteString-withBufferPool (BufferPool l h ref) f = do+withBufferPool pool@(BufferPool _ _ ref) f = do+ (buf, consumed) <- applyBufferPool pool f+ writeIORef ref $ BS.drop consumed buf+ return $ BS.take consumed buf++-- | L ike 'withBufferPool' for fillers that can decline to fill:+-- a negative return value from the filler leaves the pool untouched+-- and produces 'Nothing'.+tryWithBufferPool+ :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO (Maybe ByteString)+tryWithBufferPool pool@(BufferPool _ _ ref) f = do+ (buf, consumed) <- applyBufferPool pool f+ if consumed < 0+ then do+ writeIORef ref buf+ return Nothing+ else do+ writeIORef ref $ BS.drop consumed buf+ return $ Just $ BS.take consumed buf++applyBufferPool+ :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO (ByteString, Int)+applyBufferPool (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+ return (buf, consumed) withForeignBuffer :: ByteString -> (Buffer -> BufSize -> IO Int) -> IO Int withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s) l
Network/Socket/BufferPool/Recv.hs view
@@ -2,13 +2,14 @@ module Network.Socket.BufferPool.Recv ( receive,+ receiveNoWait, 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 (Socket, recvBuf, recvBufNoWait) import Network.Socket.BufferPool.Buffer import Network.Socket.BufferPool.Types@@ -19,6 +20,16 @@ -- The buffer pool is automatically managed. receive :: Socket -> BufferPool -> Recv receive sock pool = withBufferPool pool $ \ptr size -> recvBuf sock ptr size++-- | Like 'receive' but never blocks and never involves the IO manager:+-- 'Nothing' means no data was available (or an error occurred, which a+-- subsequent blocking 'receive' will report properly). @Just \"\"@ is EOF.+receiveNoWait :: Socket -> BufferPool -> IO (Maybe ByteString)+receiveNoWait sock pool = tryWithBufferPool pool $ \ptr size ->+ -- Both EAGAIN and real errors map to a negative result, deferring+ -- to the blocking path so errors surface there with their errno+ -- intact.+ fromIntegral <$> recvBufNoWait sock ptr size ----------------------------------------------------------------
recv.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: recv-version: 0.1.1+version: 0.1.2 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp@@ -25,7 +25,7 @@ build-depends: base >=4.12 && <5, bytestring >=0.9.1.4,- network >=3.1.0+ network >=3.2.9 if impl(ghc >=8) default-extensions: Strict StrictData@@ -47,5 +47,6 @@ build-depends: base >=4.12 && <5, bytestring >=0.9.1.4,- network >=3.1.0,- hspec+ network >=3.2.9,+ hspec,+ recv
test/BufferPoolSpec.hs view
@@ -2,12 +2,13 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B (ByteString (PS))+import Data.IORef (newIORef, readIORef, writeIORef) 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)+import Test.Hspec (Spec, describe, hspec, it, shouldBe, shouldReturn) main :: IO () main = hspec spec@@ -18,18 +19,58 @@ 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+spec = do+ 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++ describe "tryWithBufferPool" $ do+ it "returns the filled prefix when the filler fills" $ do+ pool <- newBufferPool 2048 16384+ tryWithBufferPool pool (blitBuffer (B.take 10 wantData))+ `shouldReturn` Just (B.take 10 wantData)++ it "returns an empty ByteString when the filler consumes nothing" $ do+ -- 'receiveNoWait' reports EOF this way, so it must not be 'Nothing'.+ pool <- newBufferPool 2048 16384+ tryWithBufferPool pool (\_ _ -> return 0) `shouldReturn` Just B.empty++ it "returns Nothing when the filler declines" $ do+ pool <- newBufferPool 2048 16384+ tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing++ it "keeps the leftover buffer when the filler declines" $ do+ pool <- newBufferPool 2048 16384+ -- Consume 10000 of the 16384 bytes, leaving 6384 in the pool.+ _ <- tryWithBufferPool pool $ \_ _ -> return 10000+ tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing+ -- The declined call must neither consume, drop nor reallocate the+ -- leftover: the next filler is offered exactly those 6384 bytes.+ offered <- offeredSize pool+ offered `shouldBe` 6384++ it "does not corrupt buffered data across a decline" $ do+ pool <- newBufferPool 2048 16384+ _ <- tryWithBufferPool pool $ \_ _ -> return 0+ tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing+ tryWithBufferPool pool (blitBuffer wantData)+ `shouldReturn` Just wantData++-- The 'BufSize' the pool offers to the next filler, leaving the pool as it was.+offeredSize :: BufferPool -> IO Int+offeredSize pool = do+ ref <- newIORef 0+ _ <- tryWithBufferPool pool $ \_ size -> writeIORef ref size >> return 0+ readIORef ref -- Fill the Buffer with the contents of the ByteString and return the number of -- bytes written. To be used with 'withBufferPool'.