network-bytestring 0.1.2.1 → 0.1.3
raw patch · 10 files changed
+244/−117 lines, 10 filesdep +unixdep ~basesetup-changed
Dependencies added: unix
Dependency ranges changed: base
Files
- Network/Socket/ByteString.hs +84/−45
- Network/Socket/ByteString/Internal.hs +4/−0
- Network/Socket/ByteString/Lazy.hsc +14/−10
- Network/Socket/ByteString/MsgHdr.hsc +9/−15
- README.md +3/−1
- Setup.hs +11/−4
- examples/EchoClient.hs +2/−2
- examples/EchoServer.hs +3/−3
- network-bytestring.cabal +10/−2
- tests/Simple.hs +104/−35
Network/Socket/ByteString.hs view
@@ -24,14 +24,13 @@ ( -- * Send data to a socket send , sendAll-#if !defined(mingw32_HOST_OS)- , sendMany-#endif , sendTo , sendAllTo-#if !defined(mingw32_HOST_OS)++ -- ** Vectored I/O+ -- $vectored+ , sendMany , sendManyTo-#endif -- * Receive data from a socket , recv@@ -42,7 +41,6 @@ ) where import Control.Monad (liftM, when)-import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Internal (createAndTrim) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)@@ -51,27 +49,34 @@ import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (Ptr, castPtr) import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)++import qualified Data.ByteString as B+ import Network.Socket.ByteString.Internal #if !defined(mingw32_HOST_OS) import Control.Monad (zipWithM_)-import Data.List (iterate) import Foreign.C.Types (CChar, CSize) import Foreign.Marshal.Array (allocaArray) import Foreign.Marshal.Utils (with)-import Foreign.Ptr (nullPtr, plusPtr)+import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(..))-import Network.Socket.ByteString.IOVec-import Network.Socket.ByteString.MsgHdr import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock, withSockAddr) +import Network.Socket.ByteString.IOVec (IOVec(..))+import Network.Socket.ByteString.MsgHdr (MsgHdr(..))+ # if defined(__GLASGOW_HASKELL__) import GHC.Conc (threadWaitRead, threadWaitWrite) # endif #else # if defined(__GLASGOW_HASKELL__)+# if __GLASGOW_HASKELL__ >= 611+import GHC.IO.FD+# else import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)+# endif # endif #endif @@ -94,7 +99,7 @@ c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt #endif --- -----------------------------------------------------------------------------+-- ---------------------------------------------------------------------------- -- Sending -- | Send data to the socket. The socket must be connected to a@@ -107,8 +112,13 @@ unsafeUseAsCStringLen xs $ \(str, len) -> liftM fromIntegral $ #if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+# if __GLASGOW_HASKELL__ >= 611 writeRawBufferPtr "Network.Socket.ByteString.send"+ (FD s 1) (castPtr str) 0 (fromIntegral len)+# else+ writeRawBufferPtr "Network.Socket.ByteString.send" (fromIntegral s) True str 0 (fromIntegral len)+# endif #else # if !defined(__HUGS__) throwSocketErrorIfMinus1RetryMayBlock "send"@@ -129,27 +139,6 @@ sent <- send sock bs when (sent < B.length bs) $ sendAll sock (B.drop sent bs) -#if !defined(mingw32_HOST_OS)--- | Send data to the socket. The socket must be in a connected--- state. The data is sent as if the parts have been concatenated.--- This function continues to send data until either all data has been--- sent or an error occurs. On error, an exception is raised, and--- there is no way to determine how much data, if any, was--- successfully sent. /Unix only/.-sendMany :: Socket -- ^ Connected socket- -> [ByteString] -- ^ Data to send- -> IO ()-sendMany sock@(MkSocket fd _ _ _ _) cs = do- sent <- sendManyInner- when (sent < totalLength cs) $ sendMany sock (remainingChunks sent cs)- where- sendManyInner =- liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->- throwSocketErrorIfMinus1RetryMayBlock "writev"- (threadWaitWrite (fromIntegral fd)) $- c_writev (fromIntegral fd) iovsPtr (fromIntegral iovsLen)-#endif- -- | Send data to the socket. The recipient can be specified -- explicitly, so the socket need not be in a connected state. -- Returns the number of bytes sent. Applications are responsible for@@ -175,18 +164,62 @@ sent <- sendTo sock xs addr when (sent < B.length xs) $ sendAllTo sock (B.drop sent xs) addr +-- ----------------------------------------------------------------------------+-- ** Vectored I/O++-- $vectored+--+-- Vectored I\/O, also known as scatter\/gather I\/O, allows multiple+-- data segments to be sent using a single system call, without first+-- concatenating the segments. For example, given a list of+-- @ByteString@s, @xs@,+--+-- > sendMany sock xs+--+-- is equivalent to+--+-- > sendAll sock (concat xs)+--+-- but potentially more efficient.+--+-- Vectored I\/O are often useful when implementing network protocols+-- that, for example, group data into segments consisting of one or+-- more fixed-length headers followed by a variable-length body.++-- | Send data to the socket. The socket must be in a connected+-- state. The data is sent as if the parts have been concatenated.+-- This function continues to send data until either all data has been+-- sent or an error occurs. On error, an exception is raised, and+-- there is no way to determine how much data, if any, was+-- successfully sent.+sendMany :: Socket -- ^ Connected socket+ -> [ByteString] -- ^ Data to send+ -> IO () #if !defined(mingw32_HOST_OS)+sendMany sock@(MkSocket fd _ _ _ _) cs = do+ sent <- sendManyInner+ when (sent < totalLength cs) $ sendMany sock (remainingChunks sent cs)+ where+ sendManyInner =+ liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->+ throwSocketErrorIfMinus1RetryMayBlock "writev"+ (threadWaitWrite (fromIntegral fd)) $+ c_writev (fromIntegral fd) iovsPtr (fromIntegral iovsLen)+#else+sendMany sock = sendAll sock . B.concat+#endif+ -- | Send data to the socket. The recipient can be specified -- explicitly, so the socket need not be in a connected state. The -- data is sent as if the parts have been concatenated. This function -- continues to send data until either all data has been sent or an -- error occurs. On error, an exception is raised, and there is no -- way to determine how much data, if any, was successfully sent.--- /Unix only/. sendManyTo :: Socket -- ^ Socket -> [ByteString] -- ^ Data to send -> SockAddr -- ^ Recipient address -> IO ()+#if !defined(mingw32_HOST_OS) sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do sent <- liftM fromIntegral sendManyToInner when (sent < totalLength cs) $ sendManyTo sock (remainingChunks sent cs) addr@@ -197,15 +230,15 @@ let msgHdr = MsgHdr addrPtr (fromIntegral addrSize) iovsPtr (fromIntegral iovsLen)- nullPtr 0- 0 with msgHdr $ \msgHdrPtr -> throwSocketErrorIfMinus1RetryMayBlock "sendmsg" (threadWaitWrite (fromIntegral fd)) $ c_sendmsg (fromIntegral fd) msgHdrPtr 0+#else+sendManyTo sock cs = sendAllTo sock (B.concat cs) #endif --- -----------------------------------------------------------------------------+-- ---------------------------------------------------------------------------- -- Receiving -- | Receive data from the socket. The socket must be in a connected@@ -223,15 +256,19 @@ -> Int -- ^ Maximum number of bytes to receive -> IO ByteString -- ^ Data received recv (MkSocket s _ _ _ _) nbytes- | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")- | otherwise = createAndTrim nbytes $ recvInner s nbytes+ | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")+ | otherwise = createAndTrim nbytes $ recvInner s nbytes recvInner :: CInt -> Int -> Ptr Word8 -> IO Int recvInner s nbytes ptr = fmap fromIntegral $ #if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+# if __GLASGOW_HASKELL__ >= 611+ readRawBufferPtr "Network.Socket.ByteString.recv" (FD s 1) ptr 0 (fromIntegral nbytes)+# else readRawBufferPtr "Network.Socket.ByteString.recv" (fromIntegral s) True (castPtr ptr) 0 (fromIntegral nbytes)+# endif #else # if !defined(__HUGS__) throwSocketErrorIfMinus1RetryMayBlock "recv"@@ -253,7 +290,7 @@ str <- B.packCStringLen (ptr, len) return (str, sockaddr) --- -----------------------------------------------------------------------------+-- ---------------------------------------------------------------------------- -- Not exported #if !defined(mingw32_HOST_OS)@@ -301,14 +338,16 @@ -- > -- Echo server program -- > module Main where -- >--- > import Control.Monad--- > import qualified Data.ByteString as S+-- > import Control.Monad (unless) -- > import Network.Socket hiding (recv)--- > import Network.Socket.ByteString+-- > import qualified Data.ByteString as S+-- > import Network.Socket.ByteString (recv, sendAll) -- > -- > main :: IO () -- > main = withSocketsDo $--- > do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- > do addrinfos <- getAddrInfo+-- > (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+-- > Nothing (Just "3000") -- > let serveraddr = head addrinfos -- > sock <- socket (addrFamily serveraddr) Stream defaultProtocol -- > bindSocket sock (addrAddress serveraddr)@@ -327,9 +366,9 @@ -- > -- Echo client program -- > module Main where -- >--- > import qualified Data.ByteString.Char8 as C -- > import Network.Socket hiding (recv)--- > import Network.Socket.ByteString+-- > import Network.Socket.ByteString (recv, sendAll)+-- > import qualified Data.ByteString.Char8 as C -- > -- > main :: IO () -- > main = withSocketsDo $
Network/Socket/ByteString/Internal.hs view
@@ -20,7 +20,11 @@ #endif #ifdef __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611 import GHC.IOBase (IOErrorType(..))+# else+import GHC.IO.Exception (IOErrorType(..))+# endif #elif __HUGS__ import Hugs.Prelude (IOErrorType(..)) #endif
Network/Socket/ByteString/Lazy.hsc view
@@ -35,25 +35,27 @@ ) where import Control.Monad (liftM)-import qualified Data.ByteString as S import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize) import Data.Int (Int64)-import qualified Network.Socket.ByteString as N import Network.Socket (Socket(..), ShutdownCmd(..), shutdown) import Prelude hiding (getContents) import System.IO.Unsafe (unsafeInterleaveIO) +import qualified Data.ByteString as S+import qualified Network.Socket.ByteString as N+ #if !defined(mingw32_HOST_OS) import Control.Monad (when)-import qualified Data.ByteString.Lazy as L import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Foreign.Marshal.Array (allocaArray) import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(..))-import Network.Socket.ByteString.IOVec+import Network.Socket.ByteString.IOVec (IOVec(IOVec))+import Network.Socket.ByteString.Internal (c_writev) import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock)-import Network.Socket.ByteString.Internal +import qualified Data.ByteString.Lazy as L+ # if defined(__GLASGOW_HASKELL__) import GHC.Conc (threadWaitWrite) # endif@@ -71,12 +73,14 @@ -- this function caps the amount it will attempt to send at 4MB. This -- number is large (so it should not penalize performance on fast -- networks), but not outrageously so (to avoid demanding lazily--- computed data unnecessarily early). /Unix only/.+-- computed data unnecessarily early). Before being sent, the lazy+-- 'ByteString' will be converted to a list of strict 'ByteString's+-- with 'L.toChunks'; at most 1024 chunks will be sent. /Unix only/. send :: Socket -- ^ Connected socket -> ByteString -- ^ Data to send -> IO Int64 -- ^ Number of bytes sent send (MkSocket fd _ _ _ _) s = do- let cs = L.toChunks s+ let cs = take maxNumChunks (L.toChunks s) len = length cs liftM fromIntegral . allocaArray len $ \ptr -> withPokes cs ptr $ \niovs ->@@ -88,15 +92,15 @@ where withPokes ss p f = loop ss p 0 0 where loop (c:cs) q k !niovs- | k < sendLimit =+ | k < maxNumBytes = unsafeUseAsCStringLen c $ \(ptr,len) -> do poke q $ IOVec ptr (fromIntegral len) loop cs (q `plusPtr` sizeOf (undefined :: IOVec)) (k + fromIntegral len) (niovs + 1) | otherwise = f niovs loop _ _ _ niovs = f niovs- -- maximum number of bytes to transmit in one system call- sendLimit = 4194304 :: Int+ maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call+ maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call -- | Send data to the socket. The socket must be in a connected -- state. This function continues to send data until either all data
Network/Socket/ByteString/MsgHdr.hsc view
@@ -8,20 +8,20 @@ #include <sys/types.h> #include <sys/socket.h> -import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.C.Types (CInt, CSize) import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) import Network.Socket (SockAddr)+ import Network.Socket.ByteString.IOVec (IOVec) +-- We don't use msg_control, msg_controllen, and msg_flags as these+-- don't exist on OpenSolaris. data MsgHdr = MsgHdr- { msgName :: Ptr SockAddr- , msgNameLen :: CSize- , msgIov :: Ptr IOVec- , msgIovLen :: CSize- , msgControl :: Ptr CChar- , msgControlLen :: CSize- , msgFlags :: CInt+ { msgName :: Ptr SockAddr+ , msgNameLen :: CSize+ , msgIov :: Ptr IOVec+ , msgIovLen :: CSize } instance Storable MsgHdr where@@ -33,16 +33,10 @@ nameLen <- (#peek struct msghdr, msg_namelen) p iov <- (#peek struct msghdr, msg_iov) p iovLen <- (#peek struct msghdr, msg_iovlen) p- control <- (#peek struct msghdr, msg_control) p- controlLen <- (#peek struct msghdr, msg_controllen) p- flags <- (#peek struct msghdr, msg_flags) p- return $ MsgHdr name nameLen iov iovLen control controlLen flags+ return $ MsgHdr name nameLen iov iovLen poke p mh = do (#poke struct msghdr, msg_name) p (msgName mh) (#poke struct msghdr, msg_namelen) p (msgNameLen mh) (#poke struct msghdr, msg_iov) p (msgIov mh) (#poke struct msghdr, msg_iovlen) p (msgIovLen mh)- (#poke struct msghdr, msg_control) p (msgControl mh)- (#poke struct msghdr, msg_controllen) p (msgControlLen mh)- (#poke struct msghdr, msg_flags) p (msgFlags mh)
README.md view
@@ -38,7 +38,8 @@ Make sure you write a good commit message. Commit messages should contain a short summary on a separate line and, if needed, a more thorough explanation of the change. Write full sentences and use-proper spelling, punctuation, and grammar.+proper spelling, punctuation, and grammar. See+[A Note About Git Commit Messages] [2] for more information. You might want to use `git rebase` to make sure your commits correspond to nice, logical commits. Make sure whitespace only@@ -58,3 +59,4 @@ into nice, logical commits and resend the patches. [1]: http://github.com/tibbe/haskell-style-guide+[2]: http://www.tpope.net/node/106
Setup.hs view
@@ -1,10 +1,17 @@ module Main (main) where +import Control.Monad (unless) import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))+import Distribution.Simple.Utils (die) import System.Cmd (system)+import System.Directory (doesDirectoryExist) main :: IO ()-main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' } where- runTests' _ _ _ _ = do- system "runhaskell -i./dist/build tests/Simple.hs"- return ()+main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }+ where+ runTests' _ _ _ lbi = do+ built <- doesDirectoryExist $ buildDir lbi+ unless built $ die "Run the 'build' command first."+ system "runhaskell -i./dist/build tests/Simple.hs"+ return ()
examples/EchoClient.hs view
@@ -1,9 +1,9 @@ -- Echo client program module Main where -import qualified Data.ByteString.Char8 as C import Network.Socket hiding (recv)-import Network.Socket.ByteString+import Network.Socket.ByteString (recv, sendAll)+import qualified Data.ByteString.Char8 as C main :: IO () main = withSocketsDo $
examples/EchoServer.hs view
@@ -1,10 +1,10 @@ -- Echo server program module Main where -import Control.Monad-import qualified Data.ByteString as S+import Control.Monad (unless) import Network.Socket hiding (recv)-import Network.Socket.ByteString+import qualified Data.ByteString as S+import Network.Socket.ByteString (recv, sendAll) main :: IO () main = withSocketsDo $
network-bytestring.cabal view
@@ -1,5 +1,5 @@ name: network-bytestring-version: 0.1.2.1+version: 0.1.3 synopsis: Fast, memory-efficient, low-level networking description: Fast, memory-efficient, low-level socket functions that use 'Data.ByteString's instead of 'String's.@@ -26,11 +26,19 @@ Network.Socket.ByteString.MsgHdr build-depends:- base < 4.1,+ base < 4.3, bytestring < 1.0, network >= 2.2.1.1 && < 2.3 + if !os(windows)+ build-depends:+ unix >= 2 && < 3+ extensions: CPP, ForeignFunctionInterface ghc-options: -Wall if impl(ghc >= 6.8) ghc-options: -fwarn-tabs++source-repository head+ type: git+ location: git://github.com/tibbe/network-bytestring.git
tests/Simple.hs view
@@ -4,68 +4,137 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Exception (bracket) import Control.Monad (when)-import Network.Socket hiding (recv)+import Network.Socket hiding (recv, recvFrom, send) import System.Exit (exitFailure) import Test.HUnit (Counts(..), Test(..), (@=?), runTestTT) +import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as L -import Network.Socket.ByteString+import Network.Socket.ByteString (recv, recvFrom, send, sendAll, sendMany)+import qualified Network.Socket.ByteString.Lazy as NSBL +------------------------------------------------------------------------+ port :: PortNumber port = fromIntegral (3000 :: Int) +testMsg :: S.ByteString+testMsg = C.pack "This is a test message."++testLazySend :: Test+testLazySend = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) (C.take 1024 strictTestMsg)+ client sock = NSBL.send sock lazyTestMsg >>= (@=?) 1024++ -- message containing too many chunks to be sent in one system call+ lazyTestMsg = let alphabet = map C.singleton ['a'..'z']+ in L.fromChunks (concat (replicate 100 alphabet))++ strictTestMsg = C.concat . L.toChunks $ lazyTestMsg+ ------------------------------------------------------------------------ -- Tests testSendAll :: Test-testSendAll = TestCase $ mytest client server+testSendAll = TestCase $ connectedTest client server where- server serverSock = do- (sock, _) <- accept serverSock- bytes <- recv sock 1024- testData @=? bytes- sClose sock+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = sendAll sock testMsg - client sock = do- addr <- inet_addr "127.0.0.1"- connect sock $ SockAddrInet port addr- sendAll sock testData+testSendMany :: Test+testSendMany = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)+ client sock = sendMany sock [seg1, seg2] - testData = C.pack "test"+ seg1 = C.pack "This is a "+ seg2 = C.pack "test message." +testRecv :: Test+testRecv = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = send sock testMsg++testOverFlowRecv :: Test+testOverFlowRecv = TestCase $ connectedTest client server+ where+ server sock = do seg1 <- recv sock (S.length testMsg - 3)+ seg2 <- recv sock 1024+ let msg = S.append seg1 seg2+ testMsg @=? msg++ client sock = send sock testMsg++testRecvFrom :: Test+testRecvFrom = TestCase $ connectedTest client server+ where+ server sock = do (msg, _) <- recvFrom sock 1024+ testMsg @=? msg++ client sock = send sock testMsg++testOverFlowRecvFrom :: Test+testOverFlowRecvFrom = TestCase $ connectedTest client server+ where+ server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)+ (seg2, _) <- recvFrom sock 1024+ let msg = S.append seg1 seg2+ testMsg @=? msg++ client sock = send sock testMsg+ ------------------------------------------------------------------------ -- Test helpers -- | Run a client/server pair and synchronize them so that the server -- is started before the client and the specified server action is -- finished before the client closes the connection.-mytest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()-mytest clientAct serverAct = do- barrier <- newEmptyMVar- forkIO $ server barrier- client barrier- where- server barrier = do+connectedTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()+connectedTest clientAct serverAct = do+ barrier <- newEmptyMVar+ forkIO $ server barrier+ client barrier+ where+ server barrier = do addr <- inet_addr "127.0.0.1"- bracket (socket AF_INET Stream defaultProtocol)- sClose- (\sock -> do- setSocketOption sock ReuseAddr 1- bindSocket sock (SockAddrInet port addr)- listen sock maxListenQueue- putMVar barrier ()- serverAct sock- putMVar barrier ())+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+ setSocketOption sock ReuseAddr 1+ bindSocket sock (SockAddrInet port addr)+ listen sock 1+ serverReady+ (clientSock, _) <- accept sock+ serverAct clientSock+ sClose clientSock+ putMVar barrier ()+ where+ -- | Signal to the client that it can proceed.+ serverReady = putMVar barrier () - client barrier = do+ client barrier = do takeMVar barrier- bracket (socket AF_INET Stream defaultProtocol)- sClose- (\sock -> clientAct sock >> takeMVar barrier)+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+ addr <- inet_addr "127.0.0.1"+ connect sock $ SockAddrInet port addr+ clientAct sock+ takeMVar barrier +------------------------------------------------------------------------+-- Test harness+ main :: IO () main = withSocketsDo $ do- counts <- runTestTT $ TestList [TestLabel "testSendAll" testSendAll]- when (errors counts + failures counts > 0) exitFailure+ counts <- runTestTT tests+ when (errors counts + failures counts > 0) exitFailure +tests :: Test+tests = TestList [TestLabel "testLazySend" testLazySend,+ TestLabel "testSendAll" testSendMany,+ TestLabel "testSendMany" testSendMany,+ TestLabel "testRecv" testRecv,+ TestLabel "testOverFlowRecv" testOverFlowRecv,+ TestLabel "testRecvFrom" testRecvFrom,+ TestLabel "testOverFlowRecvFrom" testOverFlowRecvFrom]