packages feed

recv 0.0.0 → 0.1.0

raw patch · 4 files changed

+36/−87 lines, 4 files

Files

Network/Socket/BufferPool.hs view
@@ -17,7 +17,7 @@ --  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 pooll and will be used next time.+--  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 (@@ -27,13 +27,9 @@   , BufferPool   , newBufferPool   , withBufferPool-  -- * RecvBuf-  , RecvBuf-  , receiveBuf   -- * RecvN   , RecvN-  , makeReceiveN-  , makePlainReceiveN+  , makeRecvN   -- * Types   , Buffer   , BufSize
Network/Socket/BufferPool/Recv.hs view
@@ -3,18 +3,15 @@  module Network.Socket.BufferPool.Recv (     receive-  , receiveBuf-  , makeReceiveN-  , makePlainReceiveN+  , makeRecvN   ) where  import qualified Data.ByteString as BS-import Data.ByteString.Internal (ByteString(..))+import Data.ByteString.Internal (ByteString(..), unsafeCreate) import Data.IORef import Foreign.C.Error (eAGAIN, getErrno, throwErrno) import Foreign.C.Types-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Ptr (Ptr, castPtr) import GHC.Conc (threadWaitRead) import Network.Socket (Socket, withFdSocket) import System.Posix.Types (Fd(..))@@ -41,41 +38,16 @@     let fd = fdSocket sock #endif     let size' = fromIntegral size-    fromIntegral <$> tryRecv fd ptr size'---------------------------------------------------------------------- | The receiving function with a buffer.---   This tries to fill the buffer.---   This returns when the buffer is filled or reaches EOF.-receiveBuf :: Socket -> RecvBuf-receiveBuf sock buf0 siz0 = do-#if MIN_VERSION_network(3,1,0)-  withFdSocket sock $ \fd -> do-#elif MIN_VERSION_network(3,0,0)-    fd <- fdSocket sock-#else-    let fd = fdSocket sock-#endif-    loop fd buf0 siz0-  where-    loop _  _   0   = return True-    loop fd buf siz = do-        n <- fromIntegral <$> tryRecv fd buf (fromIntegral siz)-        -- fixme: what should we do in the case of n == 0-        if n == 0 then-            return False-          else-            loop fd (buf `plusPtr` n) (siz - n)+    fromIntegral <$> tryReceive fd ptr size'  ---------------------------------------------------------------- -tryRecv :: CInt -> Buffer -> CSize -> IO CInt-tryRecv sock ptr size = go+tryReceive :: CInt -> Buffer -> CSize -> IO CInt+tryReceive sock ptr size = go   where     go = do #ifdef mingw32_HOST_OS-      bytes <- windowsThreadBlockHack $ fromIntegral <$> readRawBufferPtr "tryRecv" (FD sock 1) (castPtr ptr) 0 size+      bytes <- windowsThreadBlockHack $ fromIntegral <$> readRawBufferPtr "tryReceive" (FD sock 1) (castPtr ptr) 0 size #else       bytes <- c_recv sock (castPtr ptr) size 0 #endif@@ -85,7 +57,7 @@               threadWaitRead (Fd sock)               go             else-              throwErrno "tryRecv"+              throwErrno "tryReceive"          else           return bytes @@ -99,64 +71,49 @@ --   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.-makeReceiveN :: ByteString -> Recv -> RecvBuf -> IO RecvN-makeReceiveN bs0 recv recvBuf = do-    ref <- newIORef bs0-    return $ receiveN ref recv recvBuf---- | This function returns a receiving function with two receiving---   functions is created internally.---   The second argument is the lower limit of the buffer pool.---   The third argument is the size of the allocated buffer in the pool.---   The fourth argument is an initial received data.---   The returned function behaves as described in 'makeReceiveN'.-makePlainReceiveN :: Socket -> Int -> Int -> ByteString -> IO RecvN-makePlainReceiveN s l h bs0 = do+makeRecvN :: ByteString -> Recv -> IO RecvN+makeRecvN bs0 recv = do     ref <- newIORef bs0-    pool <- newBufferPool l h-    return $ receiveN ref (receive s pool) (receiveBuf s)+    return $ recvN ref recv  -- | The receiving function which receives exactly N bytes --   (the fourth argument).-receiveN :: IORef ByteString -> Recv -> RecvBuf -> RecvN-receiveN ref recv recvBuf size = do+recvN :: IORef ByteString -> Recv -> RecvN+recvN ref recv size = do     cached <- readIORef ref-    (bs, leftover) <- tryRecvN cached size recv recvBuf+    (bs, leftover) <- tryRecvN cached size recv     writeIORef ref leftover     return bs  ---------------------------------------------------------------- -tryRecvN :: ByteString -> Int -> IO ByteString -> RecvBuf -> IO (ByteString, ByteString)-tryRecvN init0 siz0 recv recvBuf+tryRecvN :: ByteString -> Int -> IO ByteString -> IO (ByteString, ByteString)+tryRecvN init0 siz0 recv   | siz0 <= len0 = return $ BS.splitAt siz0 init0-  -- fixme: hard coding 4096-  | siz0 <= 4096 = recvWithPool [init0] (siz0 - len0)-  | otherwise    = recvWithNewBuf+  | otherwise    = go (init0:) (siz0 - len0)   where     len0 = BS.length init0-    recvWithPool bss siz = do+    go build left = do         bs <- recv         let len = BS.length bs         if len == 0 then             return ("", "")-          else if len >= siz then do-            let (consume, leftover) = BS.splitAt siz bs-                ret = BS.concat $ reverse (consume : bss)+          else if len >= left then do+            let (consume, leftover) = BS.splitAt left bs+                ret = concatN siz0 $ build [consume]             return (ret, leftover)           else do-            let bss' = bs : bss-                siz' = siz - len-            recvWithPool bss' siz'-    recvWithNewBuf = do-      bs@(PS fptr _ _) <- mallocBS siz0-      withForeignPtr fptr $ \ptr -> do-          ptr' <- copy ptr init0-          full <- recvBuf ptr' (siz0 - len0)-          if full then-              return (bs, "")-            else-              return ("", "") -- fixme+            let build' = build . (bs :)+                left' = left - len+            go build' left'++concatN :: Int -> [ByteString] -> ByteString+concatN total bss0 = unsafeCreate total $ \ptr -> goCopy bss0 ptr+  where+    goCopy []       _   = return ()+    goCopy (bs:bss) ptr = do+        ptr' <- copy ptr bs+        goCopy bss ptr'  #ifndef mingw32_HOST_OS -- fixme: the type of the return value
Network/Socket/BufferPool/Types.hs view
@@ -24,9 +24,5 @@ -- | Type for the receiving function with a buffer pool. type Recv = IO ByteString --- | Type for the receiving function with a buffer.---   The result boolean indicates whether or not the buffer is fully filled.-type RecvBuf = Buffer -> BufSize -> IO Bool- -- | Type for the receiving function which receives N bytes. type RecvN = Int -> IO ByteString
recv.cabal view
@@ -1,6 +1,6 @@ Name:                recv-Version:             0.0.0-Synopsis:            Efficient netowrk recv+Version:             0.1.0+Synopsis:            Efficient network recv License:             BSD3 License-file:        LICENSE Author:              Kazu Yamamoto