1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4#include "HsNet.h"
5
6-- |
7-- Module      : Network.Socket.ByteString
8-- Copyright   : (c) Johan Tibell 2007-2010
9-- License     : BSD-style
10--
11-- Maintainer  : johan.tibell@gmail.com
12-- Stability   : stable
13-- Portability : portable
14--
15-- This module provides access to the BSD /socket/ interface.  This
16-- module is generally more efficient than the 'String' based network
17-- functions in 'Network.Socket'.  For detailed documentation, consult
18-- your favorite POSIX socket reference. All functions communicate
19-- failures by converting the error number to 'System.IO.IOError'.
20--
21-- This module is made to be imported with 'Network.Socket' like so:
22--
23-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)
24-- > import Network.Socket.ByteString
25--
26module Network.Socket.ByteString.IO
27    (
28    -- * Send data to a socket
29      send
30    , sendAll
31    , sendTo
32    , sendAllTo
33
34    -- ** Vectored I/O
35    -- $vectored
36    , sendMany
37    , sendManyTo
38
39    -- * Receive data from a socket
40    , recv
41    , recvFrom
42    , waitWhen0
43    ) where
44
45import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads)
46import Data.ByteString (ByteString)
47import qualified Data.ByteString as B
48import Data.ByteString.Internal (createAndTrim)
49import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
50import Foreign.Marshal.Alloc (allocaBytes)
51import Foreign.Ptr (castPtr)
52
53import Network.Socket.Buffer
54import Network.Socket.ByteString.Internal
55import Network.Socket.Imports
56import Network.Socket.Types
57
58#if !defined(mingw32_HOST_OS)
59import Control.Monad (zipWithM_)
60import Foreign.Marshal.Array (allocaArray)
61import Foreign.Marshal.Utils (with)
62import Foreign.Ptr (Ptr, plusPtr)
63import Foreign.Storable (Storable(..))
64import Network.Socket.Internal
65
66import Network.Socket.ByteString.IOVec (IOVec(..))
67import Network.Socket.ByteString.MsgHdr (MsgHdr(..))
68#endif
69
70-- ----------------------------------------------------------------------------
71-- Sending
72
73-- | Send data to the socket.  The socket must be connected to a
74-- remote socket.  Returns the number of bytes sent. Applications are
75-- responsible for ensuring that all data has been sent.
76send :: Socket     -- ^ Connected socket
77     -> ByteString  -- ^ Data to send
78     -> IO Int      -- ^ Number of bytes sent
79send s xs = unsafeUseAsCStringLen xs $ \(str, len) ->
80    sendBuf s (castPtr str) len
81
82waitWhen0 :: Int -> Socket -> IO ()
83waitWhen0 0 s = when rtsSupportsBoundThreads $
84    withFdSocket s $ \fd -> threadWaitWrite $ fromIntegral fd
85waitWhen0 _ _ = return ()
86
87-- | Send data to the socket.  The socket must be connected to a
88-- remote socket.  Unlike 'send', this function continues to send data
89-- until either all data has been sent or an error occurs.  On error,
90-- an exception is raised, and there is no way to determine how much
91-- data, if any, was successfully sent.
92sendAll :: Socket     -- ^ Connected socket
93        -> ByteString  -- ^ Data to send
94        -> IO ()
95sendAll _ "" = return ()
96sendAll s bs = do
97    sent <- send s bs
98    waitWhen0 sent s
99    when (sent >= 0) $ sendAll s $ B.drop sent bs
100
101-- | Send data to the socket.  The recipient can be specified
102-- explicitly, so the socket need not be in a connected state.
103-- Returns the number of bytes sent. Applications are responsible for
104-- ensuring that all data has been sent.
105sendTo :: SocketAddress sa =>
106          Socket     -- ^ Socket
107       -> ByteString  -- ^ Data to send
108       -> sa    -- ^ Recipient address
109       -> IO Int      -- ^ Number of bytes sent
110sendTo s xs sa =
111    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo s str len sa
112
113-- | Send data to the socket. The recipient can be specified
114-- explicitly, so the socket need not be in a connected state.  Unlike
115-- 'sendTo', this function continues to send data until either all
116-- data has been sent or an error occurs.  On error, an exception is
117-- raised, and there is no way to determine how much data, if any, was
118-- successfully sent.
119sendAllTo :: SocketAddress sa =>
120             Socket     -- ^ Socket
121          -> ByteString  -- ^ Data to send
122          -> sa    -- ^ Recipient address
123          -> IO ()
124sendAllTo _ "" _  = return ()
125sendAllTo s xs sa = do
126    sent <- sendTo s xs sa
127    waitWhen0 sent s
128    when (sent >= 0) $ sendAllTo s (B.drop sent xs) sa
129
130-- | Send data to the socket.  The socket must be in a connected
131-- state.  The data is sent as if the parts have been concatenated.
132-- This function continues to send data until either all data has been
133-- sent or an error occurs.  On error, an exception is raised, and
134-- there is no way to determine how much data, if any, was
135-- successfully sent.
136sendMany :: Socket       -- ^ Connected socket
137         -> [ByteString]  -- ^ Data to send
138         -> IO ()
139#if !defined(mingw32_HOST_OS)
140sendMany _ [] = return ()
141sendMany s cs = do
142    sent <- sendManyInner
143    waitWhen0 sent s
144    when (sent >= 0) $ sendMany s $ remainingChunks sent cs
145  where
146    sendManyInner =
147      fmap fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->
148          withFdSocket s $ \fd -> do
149              let len =  fromIntegral $ min iovsLen (#const IOV_MAX)
150              throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $
151                  c_writev fd iovsPtr len
152#else
153sendMany s = sendAll s . B.concat
154#endif
155
156-- | Send data to the socket.  The recipient can be specified
157-- explicitly, so the socket need not be in a connected state.  The
158-- data is sent as if the parts have been concatenated.  This function
159-- continues to send data until either all data has been sent or an
160-- error occurs.  On error, an exception is raised, and there is no
161-- way to determine how much data, if any, was successfully sent.
162sendManyTo :: Socket       -- ^ Socket
163           -> [ByteString]  -- ^ Data to send
164           -> SockAddr      -- ^ Recipient address
165           -> IO ()
166#if !defined(mingw32_HOST_OS)
167sendManyTo _ [] _    = return ()
168sendManyTo s cs addr = do
169    sent <- fromIntegral <$> sendManyToInner
170    waitWhen0 sent s
171    when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr
172  where
173    sendManyToInner =
174      withSockAddr addr $ \addrPtr addrSize ->
175        withIOVec cs $ \(iovsPtr, iovsLen) -> do
176          let msgHdr = MsgHdr
177                addrPtr (fromIntegral addrSize)
178                iovsPtr (fromIntegral iovsLen)
179          withFdSocket s $ \fd ->
180              with msgHdr $ \msgHdrPtr ->
181                throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $
182                  c_sendmsg fd msgHdrPtr 0
183#else
184sendManyTo s cs = sendAllTo s (B.concat cs)
185#endif
186
187-- ----------------------------------------------------------------------------
188-- Receiving
189
190-- | Receive data from the socket.  The socket must be in a connected
191-- state.  This function may return fewer bytes than specified.  If
192-- the message is longer than the specified length, it may be
193-- discarded depending on the type of socket.  This function may block
194-- until a message arrives.
195--
196-- Considering hardware and network realities, the maximum number of bytes to
197-- receive should be a small power of 2, e.g., 4096.
198--
199-- For TCP sockets, a zero length return value means the peer has
200-- closed its half side of the connection.
201recv :: Socket        -- ^ Connected socket
202     -> Int            -- ^ Maximum number of bytes to receive
203     -> IO ByteString  -- ^ Data received
204recv s nbytes
205    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")
206    | otherwise  = createAndTrim nbytes $ \ptr -> recvBuf s ptr nbytes
207
208-- | Receive data from the socket.  The socket need not be in a
209-- connected state.  Returns @(bytes, address)@ where @bytes@ is a
210-- 'ByteString' representing the data received and @address@ is a
211-- 'SockAddr' representing the address of the sending socket.
212--
213-- If the first return value is zero, it means EOF.
214recvFrom :: SocketAddress sa =>
215            Socket                     -- ^ Socket
216         -> Int                        -- ^ Maximum number of bytes to receive
217         -> IO (ByteString, sa)  -- ^ Data received and sender address
218recvFrom sock nbytes =
219    allocaBytes nbytes $ \ptr -> do
220        (len, sockaddr) <- recvBufFrom sock ptr nbytes
221        str <- B.packCStringLen (ptr, len)
222        return (str, sockaddr)
223
224-- ----------------------------------------------------------------------------
225-- Not exported
226
227#if !defined(mingw32_HOST_OS)
228-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write
229-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is
230-- list of chunks remaining to be sent.
231remainingChunks :: Int -> [ByteString] -> [ByteString]
232remainingChunks _ [] = []
233remainingChunks i (x:xs)
234    | i < len        = B.drop i x : xs
235    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs
236  where
237    len = B.length x
238
239-- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair
240-- consisting of a pointer to a temporarily allocated array of pointers to
241-- IOVec made from @cs@ and the number of pointers (@length cs@).
242-- /Unix only/.
243withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
244withIOVec cs f =
245    allocaArray csLen $ \aPtr -> do
246        zipWithM_ pokeIov (ptrs aPtr) cs
247        f (aPtr, csLen)
248  where
249    csLen = length cs
250    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))
251    pokeIov ptr s =
252        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->
253        poke ptr $ IOVec sPtr (fromIntegral sLen)
254#endif
255