network-bytestring 0.1.1.4 → 0.1.2

raw patch · 14 files changed

+829/−250 lines, 14 filesdep ~basedep ~bytestringdep ~networkbuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, network

API changes (from Hackage documentation)

Files

• LICENSE +0/−4
• Network/Socket/ByteString.cpphs +0/−219
• Network/Socket/ByteString.hs +344/−0
• Network/Socket/ByteString/IOVec.hsc +28/−0
• Network/Socket/ByteString/Internal.hs +43/−0
• Network/Socket/ByteString/Lazy.hsc +148/−0
• Network/Socket/ByteString/MsgHdr.hsc +48/−0
• README.md +60/−0
• Setup.hs +10/−0
• Setup.lhs +0/−3
• examples/EchoClient.hs +18/−0
• examples/EchoServer.hs +27/−0
• network-bytestring.cabal +32/−24
• tests/Simple.hs +71/−0

@@ -13,10 +13,6 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Johan Tibell nor the names of other-      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

@@ -1,219 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}---- |--- Module      : Network.Socket.ByteString--- Copyright   : (c) Johan Tibell 2007--- License     : BSD-style------ Maintainer  : johan.tibell@gmail.com--- Stability   : experimental--- Portability : portable------ A module for efficiently transmitting data over sockets. For--- detailed documentation consult your favorite POSIX socket--- reference. All functions communicate failures by converting the--- error number to an 'System.IO.IOError'.------ This module is intended to be imported together with 'Network.Socket' like so:------ > import Network.Socket hiding (send, sendTo, recv, recvFrom)--- > import Network.Socket.ByteString----module Network.Socket.ByteString-    (-     -- * Send a message on a socket-     -- | Functions used to transmit a message to another socket.-     send,-     sendTo,--     -- * Receive a message from a socket-     -- | Functions used to receive messages from a socket, and may be-     -- used to receive data on a socket whether or not it is-     -- connection-oriented.-     recv,-     recvFrom-    ) where--import Control.Monad (liftM)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Word (Word8)-import Data.ByteString.Internal (createAndTrim)-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Foreign.C.Error (eAGAIN, eINTR, eWOULDBLOCK, getErrno, throwErrno)-import Foreign.C.Types (CChar, CInt, CSize)-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Ptr (Ptr, castPtr)-import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)--#if defined(__GLASGOW_HASKELL__)-import GHC.Conc (threadWaitRead, threadWaitWrite)-import GHC.IOBase (IOErrorType(..), IOException(..))-# if defined(mingw32_HOST_OS)-import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)-# endif-#else-import System.IO.Unsafe (unsafePerformIO)-#endif--#ifndef CALLCONV-# ifdef WITH_WINSOCK-#  define CALLCONV stdcall-# else-#  define CALLCONV ccall-# endif-#endif-foreign import CALLCONV unsafe "send"-  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt-foreign import CALLCONV unsafe "recv"-  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt---- -------------------------------------------------------------------------------- Sending---- | Transmit a message to another socket. The socket must be in a--- connected state so that the intended recipient is known.-send :: Socket      -- ^ Bound\/Connected socket.-     -> ByteString  -- ^ Data to send.-     -> IO Int      -- ^ Number of bytes sent.-send (MkSocket s _family _stype _protocol status) xs = do-  unsafeUseAsCStringLen xs $ \(str, len) -> do-    liftM fromIntegral $-#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)-      writeRawBufferPtr "Network.Socket.ByteString.send" (fromIntegral s) True str 0-                (fromIntegral len)-#else-# if !defined(__HUGS__)-     throwErrnoIfMinus1Retry_repeatOnBlock "send"-        (threadWaitWrite (fromIntegral s)) $-# endif-        c_send s str (fromIntegral len) 0{-flags-}-#endif---- | Transmit a message to another socket. The recipient can be--- specified explicitly so the socket must not (but can be) in a--- connected state.-sendTo :: Socket      -- ^ (Possibly) bound\/connected socket.-       -> ByteString  -- ^ Data to send.-       -> SockAddr    -- ^ Recipient address.-       -> IO Int      -- ^ Number of bytes sent.-sendTo sock xs addr = unsafeUseAsCStringLen xs $-                      \(str, len) -> sendBufTo sock str len addr---- -------------------------------------------------------------------------------- Receiving---- | Receive a message from another socket. The socket must be in a--- connected state so that the intended recipient is known. Note that--- the length of the received data can be smaller than specified--- maximum length. If the message is longer than the specified length--- it may be discarded depending on the type of socket. May block--- until a message arrives.-recv :: Socket          -- ^ Bound\/connected socket.-     -> Int             -- Maximum number of bytes to receive.-     -> IO ByteString   -- Data received.-recv sock@(MkSocket s _ _ _ _) nbytes-    | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")-    | otherwise   = do-      createAndTrim nbytes $ recvInner s nbytes---- | This is a helper function which allows up to loop in the case of EINTR-recvInner :: CInt -> Int -> Ptr Word8 -> IO Int-recvInner s nbytes ptr = do-    len <--#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)-        readRawBufferPtr "Network.Socket.ByteString.recvLen" (fromIntegral s) True-                         (castPtr ptr) 0 (fromIntegral nbytes)-#else-# if !defined(__HUGS__)-         throwErrnoIfMinus1Retry_repeatOnBlock "recv"-                (threadWaitRead (fromIntegral s)) $-# endif-                        c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-}-#endif-    case fromIntegral len of-         0 -> ioError (mkEOFError "Network.Socket.ByteString.recv")-         (-1) -> do errno <- getErrno-                    if errno == eINTR-                       then recvInner s nbytes ptr-                       else throwErrno "Network.Socket.ByteString.recv"-         n -> return n---- | Similar to 'recv' but can be used to receive data on a socket--- that is not connection-oriented.-recvFrom :: Socket                     -- ^ (Possibly) bound\/connected socket.-         -> Int                        -- ^ Maximum number of bytes to receive.-         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address.-recvFrom sock nbytes =-    allocaBytes nbytes $ \ptr -> do-      (len, sockaddr) <- recvBufFrom sock ptr nbytes-      str <- B.packCStringLen (ptr, len)-      return (str, sockaddr)--mkInvalidRecvArgError :: String -> IOError-mkInvalidRecvArgError loc = IOError Nothing-#ifdef __GLASGOW_HASKELL__-                                    InvalidArgument-#else-                                    IllegalOperation-#endif-                                    loc "non-positive length" Nothing--mkEOFError :: String -> IOError-mkEOFError loc = IOError Nothing EOF loc "end of file" Nothing---------------------------------------------------------------------------------- Support for thread-safe blocking operations in GHC.--#if defined(__GLASGOW_HASKELL__) && !(defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS))-{-# SPECIALISE-    throwErrnoIfMinus1Retry_mayBlock-         :: String -> IO CInt -> IO CInt -> IO CInt #-}-throwErrnoIfMinus1Retry_mayBlock :: Num a => String -> IO a -> IO a -> IO a-throwErrnoIfMinus1Retry_mayBlock name on_block act = do-    res <- act-    if res == -1-        then do-            err <- getErrno-            if err == eINTR-                then throwErrnoIfMinus1Retry_mayBlock name on_block act-                else if err == eWOULDBLOCK || err == eAGAIN-                        then on_block-                        else throwErrno name-        else return res--throwErrnoIfMinus1Retry_repeatOnBlock :: Num a => String -> IO b -> IO a -> IO a-throwErrnoIfMinus1Retry_repeatOnBlock name on_block act = do-  throwErrnoIfMinus1Retry_mayBlock name (on_block >> repeat) act-  where repeat = throwErrnoIfMinus1Retry_repeatOnBlock name on_block act--#else-throwErrnoIfMinus1Retry_mayBlock name _ act-  = throwSocketErrorIfMinus1Retry name act--throwErrnoIfMinus1Retry_repeatOnBlock name _ act-  = throwSocketErrorIfMinus1Retry name act--# if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)-throwSocketErrorIfMinus1Retry name act = do-  r <- act-  if (r == -1)-   then do-    rc   <- c_getLastError-    case rc of-      10093 -> do -- WSANOTINITIALISED-        withSocketsDo (return ())-        r <- act-        if (r == -1)-         then (c_getLastError >>= throwSocketError name)-         else return r-      _ -> throwSocketError name rc-   else return r--foreign import CALLCONV unsafe "WSAGetLastError"-  c_getLastError :: IO CInt--# else-throwSocketErrorIfMinus1Retry name act = throwErrnoIfMinus1Retry name act-# endif-#endif /* __GLASGOW_HASKELL */

@@ -0,0 +1,344 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-- |+-- Module      : Network.Socket.ByteString+-- Copyright   : (c) Johan Tibell 2007+-- License     : BSD-style+--+-- Maintainer  : johan.tibell@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString+--+module Network.Socket.ByteString+  ( -- * Send data to a socket+    send+  , sendAll+#if !defined(mingw32_HOST_OS)+  , sendMany+#endif+  , sendTo+  , sendAllTo+#if !defined(mingw32_HOST_OS)+  , sendManyTo+#endif++    -- * Receive data from a socket+  , recv+  , recvFrom++    -- * Example+    -- $example+  ) 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)+import Data.Word (Word8)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr)+import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)+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.Storable (Storable(..))+import Network.Socket.ByteString.IOVec+import Network.Socket.ByteString.MsgHdr+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock,+                                withSockAddr)++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitRead, threadWaitWrite)+#  endif+#else+#  if defined(__GLASGOW_HASKELL__)+import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)+#  endif+#endif++#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)+#  define WITH_WINSOCK 1+#endif++#if !defined(CALLCONV)+#  ifdef WITH_WINSOCK+#    define CALLCONV stdcall+#  else+#    define CALLCONV ccall+#  endif+#endif++#if !defined(mingw32_HOST_OS)+foreign import CALLCONV unsafe "send"+  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt+foreign import CALLCONV unsafe "recv"+  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt+#endif++-- -----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Returns the number of bytes sent. Applications are+-- responsible for ensuring that all data has been sent.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int      -- ^ Number of bytes sent+send (MkSocket s _ _ _ _) xs =+    unsafeUseAsCStringLen xs $ \(str, len) ->+    liftM fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+        writeRawBufferPtr "Network.Socket.ByteString.send"+        (fromIntegral s) True str 0 (fromIntegral len)+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "send"+        (threadWaitWrite (fromIntegral s)) $+#  endif+        c_send s str (fromIntegral len) 0+#endif++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Unlike 'send', 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.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+    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+-- ensuring that all data has been sent.+sendTo :: Socket      -- ^ Socket+       -> ByteString  -- ^ Data to send+       -> SockAddr    -- ^ Recipient address+       -> IO Int      -- ^ Number of bytes sent+sendTo sock xs addr =+    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo sock str len addr++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  Unlike+-- 'sendTo', 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.+sendAllTo :: Socket      -- ^ Socket+          -> ByteString  -- ^ Data to send+          -> SockAddr    -- ^ Recipient address+          -> IO ()+sendAllTo sock xs addr = do+    sent <- sendTo sock xs addr+    when (sent < B.length xs) $ sendAllTo sock (B.drop sent xs) addr++#if !defined(mingw32_HOST_OS)+-- | 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 ()+sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do+    sent <- liftM fromIntegral sendManyToInner+    when (sent < totalLength cs) $ sendManyTo sock (remainingChunks sent cs) addr+  where+    sendManyToInner =+      withSockAddr addr $ \addrPtr addrSize ->+        withIOVec cs $ \(iovsPtr, iovsLen) -> do+          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+#endif++-- -----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the message is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- Considering hardware and network realities, the maximum number of bytes to+-- receive should be a small power of 2, e.g., 4096.+--+-- For TCP sockets, a zero length return value means the peer has+-- closed its half side of the connection.+recv :: Socket         -- ^ Connected socket+     -> 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++recvInner :: CInt -> Int -> Ptr Word8 -> IO Int+recvInner s nbytes ptr =+    fmap fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+        readRawBufferPtr "Network.Socket.ByteString.recv" (fromIntegral s)+        True (castPtr ptr) 0 (fromIntegral nbytes)+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "recv"+        (threadWaitRead (fromIntegral s)) $+#  endif+        c_recv s (castPtr ptr) (fromIntegral nbytes) 0+#endif++-- | Receive data from the socket.  The socket need not be in a+-- connected state.  Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+recvFrom :: Socket                     -- ^ Socket+         -> Int                        -- ^ Maximum number of bytes to receive+         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address+recvFrom sock nbytes =+    allocaBytes nbytes $ \ptr -> do+        (len, sockaddr) <- recvBufFrom sock ptr nbytes+        str <- B.packCStringLen (ptr, len)+        return (str, sockaddr)++-- -----------------------------------------------------------------------------+-- Not exported++#if !defined(mingw32_HOST_OS)+-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write+-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is+-- list of chunks remaining to be sent.+remainingChunks :: Int -> [ByteString] -> [ByteString]+remainingChunks _ [] = []+remainingChunks i (x:xs)+    | i < len        = B.drop i x : xs+    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs+  where+    len = B.length x++-- | @totalLength cs@ is the sum of the lengths of the chunks in the list @cs@.+totalLength :: [ByteString] -> Int+totalLength = sum . map B.length++-- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair+-- consisting of a pointer to a temporarily allocated array of pointers to+-- 'IOVec' made from @cs@ and the number of pointers (@length cs@).+-- /Unix only/.+withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a+withIOVec cs f =+    allocaArray csLen $ \aPtr -> do+        zipWithM_ pokeIov (ptrs aPtr) cs+        f (aPtr, csLen)+  where+    csLen = length cs+    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))+    pokeIov ptr s =+        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->+        poke ptr $ IOVec sPtr (fromIntegral sLen)+#endif++-- ---------------------------------------------------------------------+-- Example++-- $example+--+-- Here are two minimal example programs using the TCP/IP protocol: a+-- server that echoes all data that it receives back (servicing only+-- one client) and a client using it.+--+-- > -- Echo server program+-- > module Main where+-- >+-- > import Control.Monad+-- > import qualified Data.ByteString as S+-- > import Network.Socket hiding (recv)+-- > import Network.Socket.ByteString+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        bindSocket sock (addrAddress serveraddr)+-- >        listen sock 1+-- >        (conn, _) <- accept sock+-- >        talk conn+-- >        sClose conn+-- >        sClose sock+-- >+-- >     where+-- >       talk :: Socket -> IO ()+-- >       talk conn =+-- >           do msg <- recv conn 1024+-- >              unless (S.null msg) $ sendAll conn msg >> talk conn+--+-- > -- Echo client program+-- > module Main where+-- >+-- > import qualified Data.ByteString.Char8 as C+-- > import Network.Socket hiding (recv)+-- > import Network.Socket.ByteString+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        connect sock (addrAddress serveraddr)+-- >        sendAll sock $ C.pack "Hello, world!"+-- >        msg <- recv sock 1024+-- >        sClose sock+-- >        putStr "Received "+-- >        C.putStrLn msg

@@ -0,0 +1,28 @@+-- | Support module for the POSIX writev system call.+module Network.Socket.ByteString.IOVec+  ( IOVec(..)+  ) where++import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))++#include <sys/uio.h>++data IOVec = IOVec+    { iovBase :: Ptr CChar+    , iovLen  :: CSize+    }++instance Storable IOVec where+  sizeOf _    = (#const sizeof(struct iovec))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    base <- (#peek struct iovec, iov_base) p+    len  <- (#peek struct iovec, iov_len)  p+    return $ IOVec base len++  poke p iov = do+    (#poke struct iovec, iov_base) p (iovBase iov)+    (#poke struct iovec, iov_len)  p (iovLen  iov)

@@ -0,0 +1,43 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++module Network.Socket.ByteString.Internal+  ( mkInvalidRecvArgError+#if !defined(mingw32_HOST_OS)+  , c_writev+  , c_sendmsg+#endif+  ) where++import System.IO.Error (ioeSetErrorString, mkIOError)++#if !defined(mingw32_HOST_OS)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize)++import Network.Socket.ByteString.IOVec (IOVec)+import Network.Socket.ByteString.MsgHdr (MsgHdr)+#endif++#ifdef __GLASGOW_HASKELL__+import GHC.IOBase (IOErrorType(..))+#elif __HUGS__+import Hugs.Prelude (IOErrorType(..))+#endif++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError+#ifdef __GLASGOW_HASKELL__+                                    InvalidArgument+#else+                                    IllegalOperation+#endif+                                    loc Nothing Nothing) "non-positive length"++#if !defined(mingw32_HOST_OS)+foreign import ccall unsafe "writev"+  c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++foreign import ccall unsafe "sendmsg"+  c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize+#endif

@@ -0,0 +1,148 @@+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}++-- |+-- Module      : Network.Socket.ByteString.Lazy+-- Copyright   : (c) Bryan O'Sullivan 2009+-- License     : BSD-style+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : POSIX, GHC+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString.Lazy+-- > import Prelude hiding (getContents)+--+module Network.Socket.ByteString.Lazy+  (+#if !defined(mingw32_HOST_OS)+    -- * Send data to a socket+    send,+    sendAll,+#endif++    -- * Receive data from a socket+    getContents,+    recv+  ) 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)++#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.Internal (throwSocketErrorIfMinus1RetryMayBlock)+import Network.Socket.ByteString.Internal++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitWrite)+#  endif+#endif++#if !defined(mingw32_HOST_OS)+-- -----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket. The socket must be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Because a lazily generated 'ByteString' may be arbitrarily long,+-- 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/.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int64    -- ^ Number of bytes sent+send (MkSocket fd _ _ _ _) s = do+  let cs  = L.toChunks s+      len = length cs+  liftM fromIntegral . allocaArray len $ \ptr ->+    withPokes cs ptr $ \niovs ->+#  if !defined(__HUGS__)+      throwSocketErrorIfMinus1RetryMayBlock "writev"+        (threadWaitWrite (fromIntegral fd)) $+#  endif+        c_writev (fromIntegral fd) ptr niovs+  where+    withPokes ss p f = loop ss p 0 0+      where loop (c:cs) q k !niovs+                | k < sendLimit =+                    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++-- | Send data to the socket.  The socket must be in a connected+-- state. This function continues to send data until either all data+-- has been sent or an error occurs.  If there is an error, an+-- exception is raised, and there is no way to determine how much data+-- was sent.  /Unix only/.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+  sent <- send sock bs+  when (sent < L.length bs) $ sendAll sock (L.drop sent bs)+#endif++-- -----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  Data is received on demand, in chunks; each chunk will be+-- sized to reflect the amount of data received by individual 'recv'+-- calls.+--+-- All remaining data from the socket is consumed.  When there is no+-- more data to be received, the receiving side of the socket is shut+-- down.  If there is an error and an exception is thrown, the socket+-- is not shut down.+getContents :: Socket         -- ^ Connected socket+            -> IO ByteString  -- ^ Data received+getContents sock = loop where+  loop = unsafeInterleaveIO $ do+    s <- N.recv sock defaultChunkSize+    if S.null s+      then shutdown sock ShutdownReceive >> return Empty+      else Chunk s `liftM` loop++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the received data is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- If there is no more data to be received, returns an empty 'ByteString'.+recv :: Socket         -- ^ Connected socket+     -> Int64          -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv sock nbytes = chunk `liftM` N.recv sock (fromIntegral nbytes) where+  chunk k+    | S.null k  = Empty+    | otherwise = Chunk k Empty

@@ -0,0 +1,48 @@+{-# LANGUAGE CPP #-}++-- | Support module for the POSIX 'sendmsg' system call.+module Network.Socket.ByteString.MsgHdr+  ( MsgHdr(..)+  ) where++#include <sys/types.h>+#include <sys/socket.h>++import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import Network.Socket (SockAddr)+import Network.Socket.ByteString.IOVec (IOVec)++data MsgHdr = MsgHdr+    { msgName       :: Ptr SockAddr+    , msgNameLen    :: CSize+    , msgIov        :: Ptr IOVec+    , msgIovLen     :: CSize+    , msgControl    :: Ptr CChar+    , msgControlLen :: CSize+    , msgFlags      :: CInt+    }++instance Storable MsgHdr where+  sizeOf _    = (#const sizeof(struct msghdr))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    name       <- (#peek struct msghdr, msg_name)       p+    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++  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)

@@ -0,0 +1,60 @@+Fast and memory efficient low-level networking+==============================================++The network-bytestring library provides faster and more memory+efficient low-level socket functions, using `ByteString`s, than those+in the `network` library.++Contributing+------------++### Prerequisites++Make sure you read the [Haskell Style Guide] [1].++The existing code doesn't follow the style guide fully but you should+follow it for all new code.++### Creating patches++The preferred way of contributing changes to the project is to use Git+and send the patches over email using the Git commands `format-patch`+and `send-email`.  Step by step instructions:++Clone the repository:++    git clone http://github.com/tibbe/network-bytestring++Make your changes:++    cd network-bytestring+    $EDITOR <file>++Commit your changes in one or more commits:++    git add <file>+    git commit++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.++You might want to use `git rebase` to make sure your commits+correspond to nice, logical commits.  Make sure whitespace only+changes are kept in separate commits to ease reviewing.++Prepare the e.g. last five patches for sending:++    git format-patch -5 -n++This will create one patch file per patch.++    git send-email --to <maintainer> <patch files>++The maintainer is specified in the Cabal file.  The maintainer will+review your changes and may ask you to make changes to them.  Make the+changes to your local repository and use `git rebase` to massage them+into nice, logical commits and resend the patches.++[1]: http://github.com/tibbe/haskell-style-guide

@@ -0,0 +1,10 @@+module Main (main) where++import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)+import System.Cmd (system)++main :: IO ()+main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' } where+  runTests' _ _ _ _ = do+    system "runhaskell -i./dist/build tests/Simple.hs"+    return ()

@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain

@@ -0,0 +1,18 @@+-- Echo client program+module Main where++import qualified Data.ByteString.Char8 as C+import Network.Socket hiding (recv)+import Network.Socket.ByteString++main :: IO ()+main = withSocketsDo $+    do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+       let serveraddr = head addrinfos+       sock <- socket (addrFamily serveraddr) Stream defaultProtocol+       connect sock (addrAddress serveraddr)+       sendAll sock $ C.pack "Hello, world!"+       msg <- recv sock 1024+       sClose sock+       putStr "Received "+       C.putStrLn msg

@@ -0,0 +1,27 @@+-- Echo server program+module Main where++import Control.Monad+import qualified Data.ByteString as S+import Network.Socket hiding (recv)+import Network.Socket.ByteString++main :: IO ()+main = withSocketsDo $+    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)+       listen sock 1+       (conn, _) <- accept sock+       talk conn+       sClose conn+       sClose sock++    where+      talk :: Socket -> IO ()+      talk conn =+          do msg <- recv conn 1024+             unless (S.null msg) $ sendAll conn msg >> talk conn

@@ -1,28 +1,36 @@-name:               network-bytestring-version:            0.1.1.4-synopsis:           Fast and memory efficient low-level networking-description:        Faster and more memory efficient low-level socket-                    functions using 'Data.ByteString's instead of-                    'String's.-license:            BSD3-license-file:       LICENSE-author:             Johan Tibell-maintainer:         johan.tibell@gmail.com-category:           Network-build-type:         Simple-cabal-version:      >= 1.2-homepage:           http://github.com/tibbe/network-bytestring--flag split-base-  description: Chooce the new smaller, split-up base package.+name:                network-bytestring+version:             0.1.2+synopsis:            Fast, memory-efficient, low-level networking+description:         Fast, memory-efficient, low-level socket functions+                     that use 'Data.ByteString's instead of 'String's.+license:             BSD3+license-file:        LICENSE+author:              Johan Tibell <johan.tibell@gmail.com>+maintainer:          Johan Tibell <johan.tibell@gmail.com>+category:            Network+build-type:          Custom+cabal-version:       >= 1.6+homepage:            http://github.com/tibbe/network-bytestring+extra-source-files:  README.md, examples/*.hs, tests/*.hs  library-  exposed-modules:  Network.Socket.ByteString+  exposed-modules:+    Network.Socket.ByteString+    Network.Socket.ByteString.Lazy+  other-modules:+    Network.Socket.ByteString.Internal -  if flag(split-base)-    build-depends:  base >= 3 && < 4.1, bytestring-  else-    build-depends:  base < 3-  build-depends:    network >= 2.1 && < 2.3+  if !os(windows)+    other-modules:+      Network.Socket.ByteString.IOVec+      Network.Socket.ByteString.MsgHdr -  extensions:       CPP, ForeignFunctionInterface+  build-depends:+    base       < 4.1,+    bytestring < 1.0,+    network    >= 2.2.1 && < 2.3++  extensions: CPP, ForeignFunctionInterface+  ghc-options: -Wall+  if impl(ghc >= 6.8)+    ghc-options: -fwarn-tabs

@@ -0,0 +1,71 @@+module Main where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (bracket)+import Control.Monad (when)+import Network.Socket hiding (recv)+import System.Exit (exitFailure)+import Test.HUnit (Counts(..), Test(..), (@=?), runTestTT)++import qualified Data.ByteString.Char8 as C++import Network.Socket.ByteString++port :: PortNumber+port = fromIntegral (3000 :: Int)++------------------------------------------------------------------------+-- Tests++testSendAll :: Test+testSendAll = TestCase $ mytest client server+    where+      server serverSock = do+        (sock, _) <- accept serverSock+        bytes <- recv sock 1024+        testData @=? bytes+        sClose sock++      client sock = do+        addr <- inet_addr "127.0.0.1"+        connect sock $ SockAddrInet port addr+        sendAll sock testData++      testData = C.pack "test"++------------------------------------------------------------------------+-- 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+        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 ())++      client barrier = do+        takeMVar barrier+        bracket (socket AF_INET Stream defaultProtocol)+                sClose+                (\sock -> clientAct sock >> takeMVar barrier)++main :: IO ()+main = withSocketsDo $ do+  counts <- runTestTT $ TestList [TestLabel "testSendAll" testSendAll]+  when (errors counts + failures counts > 0) exitFailure+