{-# LINE 1 "Network/Socket/ByteString/IO.hsc" #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Socket.ByteString.IO
(
send
, sendAll
, sendTo
, sendAllTo
, sendWith
, sendAllWith
, sendToWith
, sendMany
, sendManyTo
, sendManyWithFds
, sendManyWith
, recv
, recvFrom
, recvWith
, recvFromWith
, recvMsgWith
, waitWhen0
, sendMsg
, sendMsgWith
, 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 Control.Concurrent.STM (STM)
import Network.Socket.Buffer
import Network.Socket.ByteString.Internal
import Network.Socket.Imports
import Network.Socket.Types
import Network.Socket.Wait
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 73 "Network/Socket/ByteString/IO.hsc" #-}
import Network.Socket.Posix.Cmsg
import Network.Socket.Posix.IOVec
import Network.Socket.Posix.MsgHdr (MsgHdr(..))
{-# LINE 82 "Network/Socket/ByteString/IO.hsc" #-}
send :: Socket
-> ByteString
-> IO Int
send :: Socket -> ByteString -> IO Int
send = Ptr () -> Socket -> ByteString -> IO Int
sendOv Ptr ()
forall a. Ptr a
nullPtr
sendOv :: Ptr () -> Socket -> ByteString -> IO Int
sendOv :: Ptr () -> Socket -> ByteString -> IO Int
sendOv Ptr ()
ov 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) ->
Ptr () -> Socket -> Ptr Word8 -> Int -> IO Int
sendBufOv Ptr ()
ov 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 ()
sendAll :: Socket
-> ByteString
-> 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
sent <- Socket -> ByteString -> IO Int
send Socket
s ByteString
bs
waitWhen0 sent s
when (sent /= B.length bs) $ loop $ B.drop sent bs
sendWith :: Socket -> ByteString -> STM a -> IO (Either a Int)
sendWith :: forall a. Socket -> ByteString -> STM a -> IO (Either a Int)
sendWith Socket
s ByteString
xs STM a
giveUp = Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> ByteString -> IO Int
sendOv Ptr ()
ov Socket
s ByteString
xs
sendAllWith :: Socket -> ByteString -> STM a -> IO (Either a ())
sendAllWith :: forall a. Socket -> ByteString -> STM a -> IO (Either a ())
sendAllWith Socket
_ ByteString
"" STM a
_ = Either a () -> IO (Either a ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a () -> IO (Either a ()))
-> Either a () -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ () -> Either a ()
forall a b. b -> Either a b
Right ()
sendAllWith Socket
s ByteString
bs STM a
giveUp = do
r <- Socket -> ByteString -> STM a -> IO (Either a Int)
forall a. Socket -> ByteString -> STM a -> IO (Either a Int)
sendWith Socket
s ByteString
bs STM a
giveUp
case r of
Left a
a -> Either a () -> IO (Either a ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a () -> IO (Either a ()))
-> Either a () -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ a -> Either a ()
forall a b. a -> Either a b
Left a
a
Right Int
sent -> Socket -> ByteString -> STM a -> IO (Either a ())
forall a. Socket -> ByteString -> STM a -> IO (Either a ())
sendAllWith Socket
s (Int -> ByteString -> ByteString
B.drop Int
sent ByteString
bs) STM a
giveUp
sendToWith
:: SocketAddress sa
=> Socket -> ByteString -> sa -> STM a -> IO (Either a Int)
sendToWith :: forall sa a.
SocketAddress sa =>
Socket -> ByteString -> sa -> STM a -> IO (Either a Int)
sendToWith Socket
s ByteString
xs sa
sa STM a
giveUp = Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> ByteString -> sa -> IO Int
forall sa.
SocketAddress sa =>
Ptr () -> Socket -> ByteString -> sa -> IO Int
sendToOv Ptr ()
ov Socket
s ByteString
xs sa
sa
sendTo :: SocketAddress sa =>
Socket
-> ByteString
-> sa
-> IO Int
sendTo :: forall sa. SocketAddress sa => Socket -> ByteString -> sa -> IO Int
sendTo = Ptr () -> Socket -> ByteString -> sa -> IO Int
forall sa.
SocketAddress sa =>
Ptr () -> Socket -> ByteString -> sa -> IO Int
sendToOv Ptr ()
forall a. Ptr a
nullPtr
sendToOv :: SocketAddress sa => Ptr () -> Socket -> ByteString -> sa -> IO Int
sendToOv :: forall sa.
SocketAddress sa =>
Ptr () -> Socket -> ByteString -> sa -> IO Int
sendToOv Ptr ()
ov 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) -> Ptr () -> Socket -> Ptr CChar -> Int -> sa -> IO Int
forall sa a.
SocketAddress sa =>
Ptr () -> Socket -> Ptr a -> Int -> sa -> IO Int
sendBufToOv Ptr ()
ov Socket
s Ptr CChar
str Int
len sa
sa
sendAllTo :: SocketAddress sa =>
Socket
-> ByteString
-> sa
-> 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
sent <- Socket -> ByteString -> sa -> IO Int
forall sa. SocketAddress sa => Socket -> ByteString -> sa -> IO Int
sendTo Socket
s ByteString
bs sa
sa
waitWhen0 sent s
when (sent /= B.length bs) $ loop $ B.drop sent bs
sendMany :: Socket
-> [ByteString]
-> 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
sent <- Socket -> [ByteString] -> IO Int
sendManyOnce Socket
s [ByteString]
cs
waitWhen0 sent s
when (sent >= 0) $ sendMany s $ remainingChunks sent cs
sendManyOnce :: Socket -> [ByteString] -> IO Int
sendManyOnce :: Socket -> [ByteString] -> IO Int
sendManyOnce = Ptr () -> Socket -> [ByteString] -> IO Int
sendManyOnceOv Ptr ()
forall a. Ptr a
nullPtr
sendManyOnceOv :: Ptr () -> Socket -> [ByteString] -> IO Int
sendManyOnceOv :: Ptr () -> Socket -> [ByteString] -> IO Int
sendManyOnceOv Ptr ()
_ov Socket
s [ByteString]
cs =
{-# LINE 208 "Network/Socket/ByteString/IO.hsc" #-}
fmap fromIntegral . withIOVecfromBS cs $ \(iovsPtr, iovsLen) ->
withFdSocket s $ \fd -> do
let len = fromIntegral $ min iovsLen (1024)
{-# LINE 211 "Network/Socket/ByteString/IO.hsc" #-}
throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $
c_writev fd iovsPtr len
{-# LINE 225 "Network/Socket/ByteString/IO.hsc" #-}
sendManyWith :: Socket -> [ByteString] -> STM a -> IO (Either a ())
sendManyWith :: forall a. Socket -> [ByteString] -> STM a -> IO (Either a ())
sendManyWith Socket
_ [] STM a
_ = Either a () -> IO (Either a ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a () -> IO (Either a ()))
-> Either a () -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ () -> Either a ()
forall a b. b -> Either a b
Right ()
sendManyWith Socket
s [ByteString]
cs STM a
giveUp = do
r <- Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> [ByteString] -> IO Int
sendManyOnceOv Ptr ()
ov Socket
s [ByteString]
cs
case r of
Left a
a -> Either a () -> IO (Either a ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a () -> IO (Either a ()))
-> Either a () -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ a -> Either a ()
forall a b. a -> Either a b
Left a
a
Right Int
sent -> Socket -> [ByteString] -> STM a -> IO (Either a ())
forall a. Socket -> [ByteString] -> STM a -> IO (Either a ())
sendManyWith Socket
s (Int -> [ByteString] -> [ByteString]
remainingChunks Int
sent [ByteString]
cs) STM a
giveUp
sendManyTo :: Socket
-> [ByteString]
-> SockAddr
-> 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
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
waitWhen0 sent s
when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) 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 257 "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 289 "Network/Socket/ByteString/IO.hsc" #-}
sendManyWithFds :: Socket
-> [ByteString]
-> [Fd]
-> 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
recv :: Socket
-> Int
-> IO ByteString
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. HasCallStack => IOError -> IO a
ioError (String -> IOError
mkInvalidRecvArgError String
"Network.Socket.ByteString.recv")
| Bool
otherwise = Ptr () -> Socket -> Int -> IO ByteString
recvOv Ptr ()
forall a. Ptr a
nullPtr Socket
s Int
nbytes
recvOv :: Ptr () -> Socket -> Int -> IO ByteString
recvOv :: Ptr () -> Socket -> Int -> IO ByteString
recvOv Ptr ()
ov Socket
s Int
nbytes = 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 -> Ptr () -> Socket -> Ptr Word8 -> Int -> IO Int
recvBufOv Ptr ()
ov Socket
s Ptr Word8
ptr Int
nbytes
recvFrom :: SocketAddress sa =>
Socket
-> Int
-> IO (ByteString, sa)
recvFrom :: forall sa. SocketAddress sa => Socket -> Int -> IO (ByteString, sa)
recvFrom = Ptr () -> Socket -> Int -> IO (ByteString, sa)
forall sa.
SocketAddress sa =>
Ptr () -> Socket -> Int -> IO (ByteString, sa)
recvFromOv Ptr ()
forall a. Ptr a
nullPtr
recvFromOv :: SocketAddress sa => Ptr () -> Socket -> Int -> IO (ByteString, sa)
recvFromOv :: forall sa.
SocketAddress sa =>
Ptr () -> Socket -> Int -> IO (ByteString, sa)
recvFromOv Ptr ()
ov 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
(len, sockaddr) <- Ptr () -> Socket -> Ptr CChar -> Int -> IO (Int, sa)
forall sa a.
SocketAddress sa =>
Ptr () -> Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFromOv Ptr ()
ov Socket
sock Ptr CChar
ptr Int
nbytes
str <- B.packCStringLen (ptr, len)
return (str, sockaddr)
recvWith :: Socket -> Int -> STM a -> IO (Either a ByteString)
recvWith :: forall a. Socket -> Int -> STM a -> IO (Either a ByteString)
recvWith Socket
s Int
nbytes STM a
giveUp
| Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
IOError -> IO (Either a ByteString)
forall a. HasCallStack => IOError -> IO a
ioError (IOError -> IO (Either a ByteString))
-> IOError -> IO (Either a ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IOError
mkInvalidRecvArgError String
"Network.Socket.ByteString.recvWith"
| Bool
otherwise = do
bs <- Int -> (Ptr Word8 -> IO Int) -> IO (Maybe ByteString)
createAndTrim' Int
nbytes ((Ptr Word8 -> IO Int) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO Int) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
IO CInt -> Socket -> Ptr Word8 -> Int -> IO Int
recvBufNoWaitOr (String -> IO CInt
forall a. String -> IO a
throwSocketError String
"Network.Socket.ByteString.recvWith") Socket
s Ptr Word8
ptr Int
nbytes
case bs of
Just ByteString
b -> Either a ByteString -> IO (Either a ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a ByteString -> IO (Either a ByteString))
-> Either a ByteString -> IO (Either a ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
b
Maybe ByteString
Nothing -> Socket
-> STM a -> (Ptr () -> IO ByteString) -> IO (Either a ByteString)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM a
giveUp ((Ptr () -> IO ByteString) -> IO (Either a ByteString))
-> (Ptr () -> IO ByteString) -> IO (Either a ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Int -> IO ByteString
recvOv Ptr ()
ov Socket
s Int
nbytes
recvFromWith
:: SocketAddress sa
=> Socket
-> Int
-> STM a
-> IO (Either a (ByteString, sa))
recvFromWith :: forall sa a.
SocketAddress sa =>
Socket -> Int -> STM a -> IO (Either a (ByteString, sa))
recvFromWith Socket
s Int
nbytes STM a
giveUp = Socket
-> STM a
-> (Ptr () -> IO (ByteString, sa))
-> IO (Either a (ByteString, sa))
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM a
giveUp ((Ptr () -> IO (ByteString, sa)) -> IO (Either a (ByteString, sa)))
-> (Ptr () -> IO (ByteString, sa))
-> IO (Either a (ByteString, sa))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Int -> IO (ByteString, sa)
forall sa.
SocketAddress sa =>
Ptr () -> Socket -> Int -> IO (ByteString, sa)
recvFromOv Ptr ()
ov Socket
s Int
nbytes
createAndTrim' :: Int -> (Ptr Word8 -> IO Int) -> IO (Maybe ByteString)
createAndTrim' :: Int -> (Ptr Word8 -> IO Int) -> IO (Maybe ByteString)
createAndTrim' Int
nbytes Ptr Word8 -> IO Int
f = do
(len, bs) <- Int -> (Ptr Word8 -> IO (Int, ByteString)) -> IO (Int, ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nbytes ((Ptr Word8 -> IO (Int, ByteString)) -> IO (Int, ByteString))
-> (Ptr Word8 -> IO (Int, ByteString)) -> IO (Int, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
len <- Ptr Word8 -> IO Int
f Ptr Word8
ptr
if len > 0
then do
b <- B.packCStringLen (castPtr ptr, len)
return (len, b)
else return (len, B.empty)
return $ if len >= 0 then Just bs else Nothing
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 411 "Network/Socket/ByteString/IO.hsc" #-}
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 425 "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]
:))
sendMsg :: Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendMsg :: Socket -> SockAddr -> [ByteString] -> [Cmsg] -> MsgFlag -> IO Int
sendMsg = Ptr ()
-> Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendMsgOv Ptr ()
forall a. Ptr a
nullPtr
sendMsgOv :: Ptr () -> Socket -> SockAddr -> [ByteString] -> [Cmsg] -> MsgFlag -> IO Int
sendMsgOv :: Ptr ()
-> Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendMsgOv Ptr ()
_ Socket
_ SockAddr
_ [] [Cmsg]
_ MsgFlag
_ = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
sendMsgOv Ptr ()
ov 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 ->
Ptr ()
-> Socket
-> SockAddr
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
forall sa.
SocketAddress sa =>
Ptr ()
-> Socket
-> sa
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendBufMsgOv Ptr ()
ov Socket
s SockAddr
addr [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags
sendMsgWith
:: Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> STM a
-> IO (Either a Int)
sendMsgWith :: forall a.
Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> STM a
-> IO (Either a Int)
sendMsgWith Socket
s SockAddr
addr [ByteString]
bss [Cmsg]
cmsgs MsgFlag
flags STM a
giveUp =
Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr ()
-> Socket
-> SockAddr
-> [ByteString]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendMsgOv Ptr ()
ov Socket
s SockAddr
addr [ByteString]
bss [Cmsg]
cmsgs MsgFlag
flags
recvMsg :: Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsg :: Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsg = Ptr ()
-> Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsgOv Ptr ()
forall a. Ptr a
nullPtr
recvMsgOv :: Ptr () -> Socket -> Int -> Int -> MsgFlag -> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsgOv :: Ptr ()
-> Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsgOv Ptr ()
ov Socket
s Int
siz Int
clen MsgFlag
flags = do
bs@(PS fptr _ _) <- 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)
withForeignPtr fptr $ \Ptr Word8
ptr -> do
(addr,len,cmsgs,flags') <- Ptr ()
-> Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (SockAddr, Int, [Cmsg], MsgFlag)
forall sa.
SocketAddress sa =>
Ptr ()
-> Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (sa, Int, [Cmsg], MsgFlag)
recvBufMsgOv Ptr ()
ov Socket
s [(Ptr Word8
ptr,Int
siz)] Int
clen MsgFlag
flags
let 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
return (addr, bs', cmsgs, flags')
recvMsgWith
:: Socket
-> Int
-> Int
-> MsgFlag
-> STM a
-> IO (Either a (SockAddr, ByteString, [Cmsg], MsgFlag))
recvMsgWith :: forall a.
Socket
-> Int
-> Int
-> MsgFlag
-> STM a
-> IO (Either a (SockAddr, ByteString, [Cmsg], MsgFlag))
recvMsgWith Socket
s Int
siz Int
clen MsgFlag
flags STM a
giveUp =
Socket
-> STM a
-> (Ptr () -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> IO (Either a (SockAddr, ByteString, [Cmsg], MsgFlag))
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM a
giveUp ((Ptr () -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> IO (Either a (SockAddr, ByteString, [Cmsg], MsgFlag)))
-> (Ptr () -> IO (SockAddr, ByteString, [Cmsg], MsgFlag))
-> IO (Either a (SockAddr, ByteString, [Cmsg], MsgFlag))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr ()
-> Socket
-> Int
-> Int
-> MsgFlag
-> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
recvMsgOv Ptr ()
ov Socket
s Int
siz Int
clen MsgFlag
flags