{-# LINE 1 "Network/Socket/ByteString/IO.hsc" #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}



-- |
-- Module      : Network.Socket.ByteString.IO
-- Copyright   : (c) Johan Tibell 2007-2010
-- License     : BSD-style
--
-- Maintainer  : johan.tibell@gmail.com
-- Stability   : stable
-- Portability : portable
--
module Network.Socket.ByteString.IO
    (
    -- * Send data to a socket
      send
    , sendAll
    , sendTo
    , sendAllTo

    -- ** Vectored I/O
    -- $vectored
    , sendMany
    , sendManyTo
    , sendManyWithFds

    -- * Receive data from a socket
    , recv
    , recvFrom
    , waitWhen0

    -- * Advanced send and recv
    , sendMsg
    , recvMsg
    , MsgFlag(..)
    , Cmsg(..)
    ) where

import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Internal (createAndTrim)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Foreign.Marshal.Alloc (allocaBytes)

import Network.Socket.Buffer
import Network.Socket.ByteString.Internal
import Network.Socket.Imports
import Network.Socket.Types

import Data.ByteString.Internal (create, ByteString(..))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (with)
import Network.Socket.Internal
import System.Posix.Types (Fd(..))

import Network.Socket.Flag


{-# LINE 62 "Network/Socket/ByteString/IO.hsc" #-}
import Network.Socket.Posix.Cmsg
import Network.Socket.Posix.IOVec
import Network.Socket.Posix.MsgHdr (MsgHdr(..))

{-# LINE 71 "Network/Socket/ByteString/IO.hsc" #-}

-- ----------------------------------------------------------------------------
-- 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 :: Socket -> ByteString -> IO Int
send Socket
s ByteString
xs = ByteString -> (CStringLen -> IO Int) -> IO Int
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
xs ((CStringLen -> IO Int) -> IO Int)
-> (CStringLen -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str, Int
len) ->
    Socket -> Ptr Word8 -> Int -> IO Int
sendBuf Socket
s (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
str) Int
len

waitWhen0 :: Int -> Socket -> IO ()
waitWhen0 :: Int -> Socket -> IO ()
waitWhen0 Int
0 Socket
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rtsSupportsBoundThreads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO ()) -> IO ()) -> (CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> Fd -> IO ()
threadWaitWrite (Fd -> IO ()) -> Fd -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> Fd
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
fd
waitWhen0 Int
_ Socket
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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 :: Socket -> ByteString -> IO ()
sendAll Socket
_ ByteString
"" = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendAll Socket
s ByteString
bs0 = ByteString -> IO ()
loop ByteString
bs0
  where
    loop :: ByteString -> IO ()
loop ByteString
bs = do
        -- "send" throws an exception.
        Int
sent <- Socket -> ByteString -> IO Int
send Socket
s ByteString
bs
        Int -> Socket -> IO ()
waitWhen0 Int
sent Socket
s
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int
B.length ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
loop (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
sent ByteString
bs

-- | 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 :: SocketAddress sa =>
          Socket     -- ^ Socket
       -> ByteString  -- ^ Data to send
       -> sa    -- ^ Recipient address
       -> IO Int      -- ^ Number of bytes sent
sendTo :: forall sa. SocketAddress sa => Socket -> ByteString -> sa -> IO Int
sendTo Socket
s ByteString
xs sa
sa =
    ByteString -> (CStringLen -> IO Int) -> IO Int
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
xs ((CStringLen -> IO Int) -> IO Int)
-> (CStringLen -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str, Int
len) -> Socket -> Ptr CChar -> Int -> sa -> IO Int
forall sa a.
SocketAddress sa =>
Socket -> Ptr a -> Int -> sa -> IO Int
sendBufTo Socket
s Ptr CChar
str Int
len sa
sa

-- | 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 :: SocketAddress sa =>
             Socket     -- ^ Socket
          -> ByteString  -- ^ Data to send
          -> sa    -- ^ Recipient address
          -> IO ()
sendAllTo :: forall sa. SocketAddress sa => Socket -> ByteString -> sa -> IO ()
sendAllTo Socket
_ ByteString
"" sa
_  = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendAllTo Socket
s ByteString
bs0 sa
sa = ByteString -> IO ()
loop ByteString
bs0
  where
    loop :: ByteString -> IO ()
loop ByteString
bs = do
        -- "send" throws an exception.
        Int
sent <- Socket -> ByteString -> sa -> IO Int
forall sa. SocketAddress sa => Socket -> ByteString -> sa -> IO Int
sendTo Socket
s ByteString
bs sa
sa
        Int -> Socket -> IO ()
waitWhen0 Int
sent Socket
s
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int
B.length ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
loop (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
sent ByteString
bs

-- | 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 ()
sendMany :: Socket -> [ByteString] -> IO ()
sendMany Socket
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendMany Socket
s [ByteString]
cs = do
    Int
sent <- IO Int
sendManyInner
    Int -> Socket -> IO ()
waitWhen0 Int
sent Socket
s
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> [ByteString] -> IO ()
sendMany Socket
s ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
remainingChunks Int
sent [ByteString]
cs
  where
    sendManyInner :: IO Int
sendManyInner =

{-# LINE 155 "Network/Socket/ByteString/IO.hsc" #-}
      fmap fromIntegral . withIOVecfromBS cs $ \(iovsPtr, iovsLen) ->
          withFdSocket s $ \fd -> do
              let len =  fromIntegral $ min iovsLen (1024)
{-# LINE 158 "Network/Socket/ByteString/IO.hsc" #-}
              throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $
                  c_writev fd iovsPtr len

{-# LINE 169 "Network/Socket/ByteString/IO.hsc" #-}

-- | 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.
sendManyTo :: Socket       -- ^ Socket
           -> [ByteString]  -- ^ Data to send
           -> SockAddr      -- ^ Recipient address
           -> IO ()
sendManyTo :: Socket -> [ByteString] -> SockAddr -> IO ()
sendManyTo Socket
_ [] SockAddr
_    = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendManyTo Socket
s [ByteString]
cs SockAddr
addr = do
    Int
sent <- CSsize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSsize -> Int) -> IO CSsize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CSsize
sendManyToInner
    Int -> Socket -> IO ()
waitWhen0 Int
sent Socket
s
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> [ByteString] -> SockAddr -> IO ()
sendManyTo Socket
s (Int -> [ByteString] -> [ByteString]
remainingChunks Int
sent [ByteString]
cs) SockAddr
addr
  where
    sendManyToInner :: IO CSsize
sendManyToInner =
      SockAddr -> (Ptr SockAddr -> Int -> IO CSsize) -> IO CSsize
forall a. SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
withSockAddr SockAddr
addr ((Ptr SockAddr -> Int -> IO CSsize) -> IO CSsize)
-> (Ptr SockAddr -> Int -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \Ptr SockAddr
addrPtr Int
addrSize ->

{-# LINE 189 "Network/Socket/ByteString/IO.hsc" #-}
        [ByteString] -> ((Ptr IOVec, Int) -> IO CSsize) -> IO CSsize
forall a. [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
withIOVecfromBS [ByteString]
cs (((Ptr IOVec, Int) -> IO CSsize) -> IO CSsize)
-> ((Ptr IOVec, Int) -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \(Ptr IOVec
iovsPtr, Int
iovsLen) -> do
          let msgHdr :: MsgHdr SockAddr
msgHdr = MsgHdr {
                  msgName :: Ptr SockAddr
msgName    = Ptr SockAddr
addrPtr
                , msgNameLen :: Word32
msgNameLen = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
addrSize
                , msgIov :: Ptr IOVec
msgIov     = Ptr IOVec
iovsPtr
                , msgIovLen :: CSize
msgIovLen  = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iovsLen
                , msgCtrl :: Ptr Word8
msgCtrl    = Ptr Word8
forall a. Ptr a
nullPtr
                , msgCtrlLen :: CSize
msgCtrlLen = CSize
0
                , msgFlags :: CInt
msgFlags   = CInt
0
                }
          Socket -> (CInt -> IO CSsize) -> IO CSsize
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CSsize) -> IO CSsize)
-> (CInt -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
              MsgHdr SockAddr
-> (Ptr (MsgHdr SockAddr) -> IO CSsize) -> IO CSsize
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with MsgHdr SockAddr
msgHdr ((Ptr (MsgHdr SockAddr) -> IO CSsize) -> IO CSsize)
-> (Ptr (MsgHdr SockAddr) -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \Ptr (MsgHdr SockAddr)
msgHdrPtr ->
                Socket -> String -> IO CSsize -> IO CSsize
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitWrite Socket
s String
"Network.Socket.ByteString.sendManyTo" (IO CSsize -> IO CSsize) -> IO CSsize -> IO CSsize
forall a b. (a -> b) -> a -> b
$
                  CInt -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
c_sendmsg CInt
fd Ptr (MsgHdr SockAddr)
msgHdrPtr CInt
0

{-# LINE 221 "Network/Socket/ByteString/IO.hsc" #-}

-- | Send data and file descriptors over a UNIX-domain socket in
--   a single system call. This function does not work on Windows.
sendManyWithFds :: Socket       -- ^ Socket
                -> [ByteString] -- ^ Data to send
                -> [Fd]         -- ^ File descriptors
                -> IO ()
sendManyWithFds :: Socket -> [ByteString] -> [Fd] -> IO ()
sendManyWithFds Socket
s [ByteString]
bss [Fd]
fds =
    IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
        [ByteString] -> ([(Ptr Word8, Int)] -> IO Int) -> IO Int
forall a. [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
withBufSizs [ByteString]
bss (([(Ptr Word8, Int)] -> IO Int) -> IO Int)
-> ([(Ptr Word8, Int)] -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \[(Ptr Word8, Int)]
bufsizs ->
            Socket
-> NullSockAddr
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
forall sa.
SocketAddress sa =>
Socket -> sa -> [(Ptr Word8, Int)] -> [Cmsg] -> MsgFlag -> IO Int
sendBufMsg Socket
s NullSockAddr
addr [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags
  where
    addr :: NullSockAddr
addr = NullSockAddr
NullSockAddr
    cmsgs :: [Cmsg]
cmsgs = [Fd] -> Cmsg
forall a. ControlMessage a => a -> Cmsg
encodeCmsg ([Fd] -> Cmsg) -> (Fd -> [Fd]) -> Fd -> Cmsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fd -> [Fd] -> [Fd]
forall a. a -> [a] -> [a]
:[]) (Fd -> Cmsg) -> [Fd] -> [Cmsg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fd]
fds
    flags :: MsgFlag
flags = MsgFlag
forall a. Monoid a => a
mempty

-- ----------------------------------------------------------------------------
-- 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.
--
-- Currently, the 'recv' family is blocked on Windows because a proper
-- IO manager is not implemented. To use with 'System.Timeout.timeout'
-- on Windows, use 'Network.Socket.setSocketOption' with
-- 'Network.Socket.RecvTimeOut' as well.
recv :: Socket        -- ^ Connected socket
     -> Int            -- ^ Maximum number of bytes to receive
     -> IO ByteString  -- ^ Data received
recv :: Socket -> Int -> IO ByteString
recv Socket
s Int
nbytes
    | Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IOError -> IO ByteString
forall a. IOError -> IO a
ioError (String -> IOError
mkInvalidRecvArgError String
"Network.Socket.ByteString.recv")
    | Bool
otherwise  = Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
nbytes ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Socket -> Ptr Word8 -> Int -> IO Int
recvBuf Socket
s Ptr Word8
ptr Int
nbytes

-- | 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.
--
-- If the first return value is zero, it means EOF.
recvFrom :: SocketAddress sa =>
            Socket                     -- ^ Socket
         -> Int                        -- ^ Maximum number of bytes to receive
         -> IO (ByteString, sa)  -- ^ Data received and sender address
recvFrom :: forall sa. SocketAddress sa => Socket -> Int -> IO (ByteString, sa)
recvFrom Socket
sock Int
nbytes =
    Int -> (Ptr CChar -> IO (ByteString, sa)) -> IO (ByteString, sa)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nbytes ((Ptr CChar -> IO (ByteString, sa)) -> IO (ByteString, sa))
-> (Ptr CChar -> IO (ByteString, sa)) -> IO (ByteString, sa)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr -> do
        (Int
len, sa
sockaddr) <- Socket -> Ptr CChar -> Int -> IO (Int, sa)
forall sa a.
SocketAddress sa =>
Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFrom Socket
sock Ptr CChar
ptr Int
nbytes
        ByteString
str <- CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
ptr, Int
len)
        (ByteString, sa) -> IO (ByteString, sa)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
str, sa
sockaddr)

-- ----------------------------------------------------------------------------
-- Not exported


-- | 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 :: Int -> [ByteString] -> [ByteString]
remainingChunks Int
_ [] = []
remainingChunks Int
i (ByteString
x:[ByteString]
xs)
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len        = Int -> ByteString -> ByteString
B.drop Int
i ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
xs
    | Bool
otherwise      = let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len in Int
i' Int -> [ByteString] -> [ByteString]
forall a b. a -> b -> b
`seq` Int -> [ByteString] -> [ByteString]
remainingChunks Int
i' [ByteString]
xs
  where
    len :: Int
len = ByteString -> Int
B.length ByteString
x


{-# LINE 295 "Network/Socket/ByteString/IO.hsc" #-}
-- | @withIOVecfromBS 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/.
withIOVecfromBS :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
withIOVecfromBS :: forall a. [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
withIOVecfromBS [ByteString]
cs (Ptr IOVec, Int) -> IO a
f = [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
forall a. [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
withBufSizs [ByteString]
cs (([(Ptr Word8, Int)] -> IO a) -> IO a)
-> ([(Ptr Word8, Int)] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[(Ptr Word8, Int)]
bufsizs -> [(Ptr Word8, Int)] -> ((Ptr IOVec, Int) -> IO a) -> IO a
forall a. [(Ptr Word8, Int)] -> ((Ptr IOVec, Int) -> IO a) -> IO a
withIOVec [(Ptr Word8, Int)]
bufsizs (Ptr IOVec, Int) -> IO a
f

{-# LINE 309 "Network/Socket/ByteString/IO.hsc" #-}

withBufSizs :: [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
withBufSizs :: forall a. [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
withBufSizs [ByteString]
bss0 [(Ptr Word8, Int)] -> IO a
f = [ByteString] -> ([(Ptr Word8, Int)] -> [(Ptr Word8, Int)]) -> IO a
forall {b}.
[ByteString] -> ([(Ptr b, Int)] -> [(Ptr Word8, Int)]) -> IO a
loop [ByteString]
bss0 [(Ptr Word8, Int)] -> [(Ptr Word8, Int)]
forall a. a -> a
id
  where
    loop :: [ByteString] -> ([(Ptr b, Int)] -> [(Ptr Word8, Int)]) -> IO a
loop []                    [(Ptr b, Int)] -> [(Ptr Word8, Int)]
build = [(Ptr Word8, Int)] -> IO a
f ([(Ptr Word8, Int)] -> IO a) -> [(Ptr Word8, Int)] -> IO a
forall a b. (a -> b) -> a -> b
$ [(Ptr b, Int)] -> [(Ptr Word8, Int)]
build []
    loop (PS ForeignPtr Word8
fptr Int
off Int
len:[ByteString]
bss) [(Ptr b, Int)] -> [(Ptr Word8, Int)]
build = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        let ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
        [ByteString] -> ([(Ptr b, Int)] -> [(Ptr Word8, Int)]) -> IO a
loop [ByteString]
bss ([(Ptr b, Int)] -> [(Ptr Word8, Int)]
build ([(Ptr b, Int)] -> [(Ptr Word8, Int)])
-> ([(Ptr b, Int)] -> [(Ptr b, Int)])
-> [(Ptr b, Int)]
-> [(Ptr Word8, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr b
forall a. Ptr a
ptr',Int
len) (Ptr b, Int) -> [(Ptr b, Int)] -> [(Ptr b, Int)]
forall a. a -> [a] -> [a]
:))

-- | Send data to the socket using sendmsg(2).
sendMsg :: Socket       -- ^ Socket
        -> SockAddr     -- ^ Destination address
        -> [ByteString] -- ^ Data to be sent
        -> [Cmsg]       -- ^ Control messages
        -> MsgFlag      -- ^ Message flags
        -> IO Int       -- ^ The length actually sent
sendMsg :: Socket -> SockAddr -> [ByteString] -> [Cmsg] -> MsgFlag -> IO Int
sendMsg Socket
_ SockAddr
_    []  [Cmsg]
_ MsgFlag
_ = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
sendMsg Socket
s SockAddr
addr [ByteString]
bss [Cmsg]
cmsgs MsgFlag
flags = [ByteString] -> ([(Ptr Word8, Int)] -> IO Int) -> IO Int
forall a. [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
withBufSizs [ByteString]
bss (([(Ptr Word8, Int)] -> IO Int) -> IO Int)
-> ([(Ptr Word8, Int)] -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \[(Ptr Word8, Int)]
bufsizs ->
    Socket
-> SockAddr -> [(Ptr Word8, Int)] -> [Cmsg] -> MsgFlag -> IO Int
forall sa.
SocketAddress sa =>
Socket -> sa -> [(Ptr Word8, Int)] -> [Cmsg] -> MsgFlag -> IO Int
sendBufMsg Socket
s SockAddr
addr [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags

-- | Receive data from the socket using recvmsg(2).
recvMsg :: Socket  -- ^ Socket
        -> Int     -- ^ The maximum length of data to be received
                   --   If the total length is not large enough,
                   --   'MSG_TRUNC' is returned
        -> Int     -- ^ The buffer size for control messages.
                   --   If the length is not large enough,
                   --   'MSG_CTRUNC' is returned
        -> MsgFlag -- ^ Message flags
        -> IO (SockAddr, ByteString, [Cmsg], MsgFlag) -- ^ Source address, received data, control messages and message flags
recvMsg :: Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsg Socket
s Int
siz Int
clen MsgFlag
flags = do
    bs :: ByteString
bs@(PS ForeignPtr Word8
fptr Int
_ Int
_) <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
siz ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word8 -> CSize -> IO ()
forall a. Ptr a -> CSize -> IO ()
zeroMemory Ptr Word8
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
    ForeignPtr Word8
-> (Ptr Word8 -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
 -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> (Ptr Word8 -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        (SockAddr
addr,Int
len,[Cmsg]
cmsgs,MsgFlag
flags') <- Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (SockAddr, Int, [Cmsg], MsgFlag)
forall sa.
SocketAddress sa =>
Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (sa, Int, [Cmsg], MsgFlag)
recvBufMsg Socket
s [(Ptr Word8
ptr,Int
siz)] Int
clen MsgFlag
flags
        let bs' :: ByteString
bs' | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siz = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr Int
0 Int
len
                | Bool
otherwise = ByteString
bs
        (SockAddr, ByteString, [Cmsg], MsgFlag)
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SockAddr
addr, ByteString
bs', [Cmsg]
cmsgs, MsgFlag
flags')