{-# LINE 1 "Network/Socket/Buffer.hsc" #-}
{-# LANGUAGE CPP #-}
#include "HsNetDef.h"
{-# LINE 7 "Network/Socket/Buffer.hsc" #-}
module Network.Socket.Buffer (
sendBufTo
, sendBuf
, recvBufFrom
, recvBuf
, recvBufNoWait
, sendBufMsg
, recvBufMsg
) where
{-# LINE 19 "Network/Socket/Buffer.hsc" #-}
import Foreign.C.Error (getErrno, eAGAIN, eWOULDBLOCK)
{-# LINE 23 "Network/Socket/Buffer.hsc" #-}
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Utils (with)
import GHC.IO.Exception (IOErrorType(InvalidArgument))
import System.IO.Error (mkIOError, ioeSetErrorString, catchIOError)
{-# LINE 34 "Network/Socket/Buffer.hsc" #-}
import Network.Socket.Posix.CmsgHdr
import Network.Socket.Posix.MsgHdr
import Network.Socket.Posix.IOVec
{-# LINE 38 "Network/Socket/Buffer.hsc" #-}
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Name
import Network.Socket.Types
import Network.Socket.Flag
{-# LINE 49 "Network/Socket/Buffer.hsc" #-}
sendBufTo :: SocketAddress sa =>
Socket
-> Ptr a
-> Int
-> sa
-> IO Int
sendBufTo :: forall sa a.
SocketAddress sa =>
Socket -> Ptr a -> Int -> sa -> IO Int
sendBufTo Socket
s Ptr a
ptr Int
nbytes sa
sa =
sa -> (Ptr sa -> Int -> IO Int) -> IO Int
forall sa a.
SocketAddress sa =>
sa -> (Ptr sa -> Int -> IO a) -> IO a
withSocketAddress sa
sa ((Ptr sa -> Int -> IO Int) -> IO Int)
-> (Ptr sa -> Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr sa
p_sa Int
siz -> CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Socket -> (CInt -> IO CInt) -> IO CInt
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CInt) -> IO CInt) -> (CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
let sz :: CInt
sz = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz
n :: CSize
n = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes
flags :: CInt
flags = CInt
0
Socket -> String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitWrite Socket
s String
"Network.Socket.sendBufTo" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt
forall a sa.
CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt
c_sendto CInt
fd Ptr a
ptr CSize
n CInt
flags Ptr sa
p_sa CInt
sz
{-# LINE 76 "Network/Socket/Buffer.hsc" #-}
sendBuf :: Socket
-> Ptr Word8
-> Int
-> IO Int
sendBuf :: Socket -> Ptr Word8 -> Int -> IO Int
sendBuf Socket
s Ptr Word8
str Int
len = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
{-# LINE 95 "Network/Socket/Buffer.hsc" #-}
Socket -> (CInt -> IO CInt) -> IO CInt
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CInt) -> IO CInt) -> (CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
let flags :: CInt
flags = CInt
0
clen :: CSize
clen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
Socket -> String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitWrite Socket
s String
"Network.Socket.sendBuf" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr Word8 -> CSize -> CInt -> IO CInt
forall a. CInt -> Ptr a -> CSize -> CInt -> IO CInt
c_send CInt
fd Ptr Word8
str CSize
clen CInt
flags
{-# LINE 101 "Network/Socket/Buffer.hsc" #-}
recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFrom :: forall sa a.
SocketAddress sa =>
Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFrom Socket
s Ptr a
ptr Int
nbytes
| Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = IOError -> IO (Int, sa)
forall a. IOError -> IO a
ioError (String -> IOError
mkInvalidRecvArgError String
"Network.Socket.recvBufFrom")
| Bool
otherwise = (Ptr sa -> Int -> IO (Int, sa)) -> IO (Int, sa)
forall sa a. SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a
withNewSocketAddress ((Ptr sa -> Int -> IO (Int, sa)) -> IO (Int, sa))
-> (Ptr sa -> Int -> IO (Int, sa)) -> IO (Int, sa)
forall a b. (a -> b) -> a -> b
$ \Ptr sa
ptr_sa Int
sz -> (Ptr CInt -> IO (Int, sa)) -> IO (Int, sa)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, sa)) -> IO (Int, sa))
-> (Ptr CInt -> IO (Int, sa)) -> IO (Int, sa)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr_len ->
Socket -> (CInt -> IO (Int, sa)) -> IO (Int, sa)
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO (Int, sa)) -> IO (Int, sa))
-> (CInt -> IO (Int, sa)) -> IO (Int, sa)
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr_len (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
let cnbytes :: CSize
cnbytes = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes
flags :: CInt
flags = CInt
0
CInt
len <- Socket -> String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitRead Socket
s String
"Network.Socket.recvBufFrom" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt
forall a sa.
CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt
c_recvfrom CInt
fd Ptr a
ptr CSize
cnbytes CInt
flags Ptr sa
ptr_sa Ptr CInt
ptr_len
sa
sockaddr <- Ptr sa -> IO sa
forall sa. SocketAddress sa => Ptr sa -> IO sa
peekSocketAddress Ptr sa
ptr_sa
IO sa -> (IOError -> IO sa) -> IO sa
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> Socket -> IO sa
forall sa. SocketAddress sa => Socket -> IO sa
getPeerName Socket
s
(Int, sa) -> IO (Int, sa)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len, sa
sockaddr)
recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int
recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int
recvBuf Socket
s Ptr Word8
ptr Int
nbytes
| Int
nbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = IOError -> IO Int
forall a. IOError -> IO a
ioError (String -> IOError
mkInvalidRecvArgError String
"Network.Socket.recvBuf")
| Bool
otherwise = do
{-# LINE 151 "Network/Socket/Buffer.hsc" #-}
CInt
len <- Socket -> (CInt -> IO CInt) -> IO CInt
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CInt) -> IO CInt) -> (CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
Socket -> String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitRead Socket
s String
"Network.Socket.recvBuf" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
c_recv CInt
fd (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes) CInt
0
{-# LINE 155 "Network/Socket/Buffer.hsc" #-}
return $ fromIntegral len
recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int
recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int
recvBufNoWait Socket
s Ptr Word8
ptr Int
nbytes = Socket -> (CInt -> IO Int) -> IO Int
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO Int) -> IO Int) -> (CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
{-# LINE 183 "Network/Socket/Buffer.hsc" #-}
CInt
r <- CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
c_recv CInt
fd (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbytes) CInt
0
if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0 then
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r
else do
Errno
err <- IO Errno
getErrno
if Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eAGAIN Bool -> Bool -> Bool
|| Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eWOULDBLOCK then
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
else
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
2)
{-# LINE 193 "Network/Socket/Buffer.hsc" #-}
mkInvalidRecvArgError :: String -> IOError
mkInvalidRecvArgError :: String -> IOError
mkInvalidRecvArgError String
loc = IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError
IOErrorType
InvalidArgument
String
loc Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) String
"non-positive length"
sendBufMsg :: SocketAddress sa
=> Socket
-> sa
-> [(Ptr Word8,Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendBufMsg :: forall sa.
SocketAddress sa =>
Socket -> sa -> [(Ptr Word8, Int)] -> [Cmsg] -> MsgFlag -> IO Int
sendBufMsg Socket
s sa
sa [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags = do
CInt
sz <- sa -> (Ptr sa -> Int -> IO CInt) -> IO CInt
forall sa a.
SocketAddress sa =>
sa -> (Ptr sa -> Int -> IO a) -> IO a
withSocketAddress sa
sa ((Ptr sa -> Int -> IO CInt) -> IO CInt)
-> (Ptr sa -> Int -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr sa
addrPtr Int
addrSize ->
{-# LINE 210 "Network/Socket/Buffer.hsc" #-}
withIOVec bufsizs $ \(iovsPtr, iovsLen) -> do
{-# LINE 214 "Network/Socket/Buffer.hsc" #-}
withCmsgs cmsgs $ \ctrlPtr ctrlLen -> do
let msgHdr = MsgHdr {
msgName = addrPtr
, msgNameLen = fromIntegral addrSize
{-# LINE 219 "Network/Socket/Buffer.hsc" #-}
, msgIov = iovsPtr
, msgIovLen = fromIntegral iovsLen
{-# LINE 225 "Network/Socket/Buffer.hsc" #-}
, msgCtrl = castPtr ctrlPtr
, msgCtrlLen = fromIntegral ctrlLen
, msgFlags = 0
}
cflags = fromMsgFlag flags
withFdSocket s $ \fd ->
with msgHdr $ \msgHdrPtr ->
throwSocketErrorWaitWrite s "Network.Socket.Buffer.sendMsg" $
{-# LINE 234 "Network/Socket/Buffer.hsc" #-}
c_sendmsg fd msgHdrPtr cflags
{-# LINE 239 "Network/Socket/Buffer.hsc" #-}
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sz
recvBufMsg :: SocketAddress sa
=> Socket
-> [(Ptr Word8,Int)]
-> Int
-> MsgFlag
-> IO (sa,Int,[Cmsg],MsgFlag)
recvBufMsg :: forall sa.
SocketAddress sa =>
Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (sa, Int, [Cmsg], MsgFlag)
recvBufMsg Socket
s [(Ptr Word8, Int)]
bufsizs Int
clen MsgFlag
flags = do
(Ptr sa -> Int -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag)
forall sa a. SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a
withNewSocketAddress ((Ptr sa -> Int -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag))
-> (Ptr sa -> Int -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag)
forall a b. (a -> b) -> a -> b
$ \Ptr sa
addrPtr Int
addrSize ->
Int
-> (Ptr Any -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
clen ((Ptr Any -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag))
-> (Ptr Any -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (sa, Int, [Cmsg], MsgFlag)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ctrlPtr ->
{-# LINE 259 "Network/Socket/Buffer.hsc" #-}
withIOVec bufsizs $ \(iovsPtr, iovsLen) -> do
let msgHdr = MsgHdr {
msgName = addrPtr
, msgNameLen = fromIntegral addrSize
, msgIov = iovsPtr
, msgIovLen = fromIntegral iovsLen
, msgCtrl = castPtr ctrlPtr
, msgCtrlLen = fromIntegral clen
, msgFlags = 0
{-# LINE 279 "Network/Socket/Buffer.hsc" #-}
}
_cflags = fromMsgFlag flags
withFdSocket s $ \fd -> do
with msgHdr $ \msgHdrPtr -> do
len <- (fmap fromIntegral) <$>
{-# LINE 285 "Network/Socket/Buffer.hsc" #-}
throwSocketErrorWaitRead s "Network.Socket.Buffer.recvmsg" $
c_recvmsg fd msgHdrPtr _cflags
{-# LINE 293 "Network/Socket/Buffer.hsc" #-}
sockaddr <- peekSocketAddress addrPtr `catchIOError` \_ -> getPeerName s
hdr <- peek msgHdrPtr
cmsgs <- parseCmsgs msgHdrPtr
let flags' = MsgFlag $ fromIntegral $ msgFlags hdr
return (sockaddr, len, cmsgs, flags')
{-# LINE 300 "Network/Socket/Buffer.hsc" #-}
foreign import ccall unsafe "send"
c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "sendmsg"
c_sendmsg :: CInt -> Ptr (MsgHdr sa) -> CInt -> IO CInt
foreign import ccall unsafe "recvmsg"
c_recvmsg :: CInt -> Ptr (MsgHdr sa) -> CInt -> IO CInt
{-# LINE 317 "Network/Socket/Buffer.hsc" #-}
foreign import ccall unsafe "recv"
c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
foreign import CALLCONV SAFE_ON_WIN "sendto"
c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt
foreign import CALLCONV SAFE_ON_WIN "recvfrom"
c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt