# 1 "Network/Socket/ByteString.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 13 "<command-line>"
# 1 "./dist/build/autogen/cabal_macros.h" 1
# 13 "<command-line>" 2
# 1 "Network/Socket/ByteString.cpphs"
module Network.Socket.ByteString
(
send,
sendTo,
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)
import GHC.Conc (threadWaitRead, threadWaitWrite)
import GHC.IOBase (IOErrorType(..), IOException(..))
foreign import ccall unsafe "send"
c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "recv"
c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
send :: Socket
-> ByteString
-> IO Int
send (MkSocket s _family _stype _protocol status) xs = do
unsafeUseAsCStringLen xs $ \(str, len) -> do
liftM fromIntegral $
throwErrnoIfMinus1Retry_repeatOnBlock "send"
(threadWaitWrite (fromIntegral s)) $
c_send s str (fromIntegral len) 0
sendTo :: Socket
-> ByteString
-> SockAddr
-> IO Int
sendTo sock xs addr = unsafeUseAsCStringLen xs $
\(str, len) -> sendBufTo sock str len addr
recv :: Socket
-> Int
-> IO ByteString
recv sock@(MkSocket s _ _ _ _) nbytes
| nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")
| otherwise = do
createAndTrim nbytes $ recvInner s nbytes
recvInner :: CInt -> Int -> Ptr Word8 -> IO Int
recvInner s nbytes ptr = do
len <-
throwErrnoIfMinus1Retry_repeatOnBlock "recv"
(threadWaitRead (fromIntegral s)) $
c_recv s (castPtr ptr) (fromIntegral nbytes) 0
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
recvFrom :: Socket
-> Int
-> IO (ByteString, SockAddr)
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
InvalidArgument
loc "non-positive length" Nothing
mkEOFError :: String -> IOError
mkEOFError loc = IOError Nothing EOF loc "end of file" Nothing
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