{-# language BangPatterns #-}
{-# language CPP #-}
{-# language DataKinds #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language PatternSynonyms #-}
{-# language ScopedTypeVariables #-}
{-# language UnboxedTuples #-}
{-# language UnliftedFFITypes #-}
module Posix.Socket
(
uninterruptibleSocket
, uninterruptibleSocketPair
, getAddressInfo
, uninterruptibleFreeAddressInfo
, uninterruptibleBind
, connect
, uninterruptibleConnect
, uninterruptibleConnectPtr
, uninterruptibleListen
, accept
, uninterruptibleAccept
, accept_
, uninterruptibleGetSocketName
, uninterruptibleGetSocketOption
, uninterruptibleSetSocketOption
, uninterruptibleSetSocketOptionByteArray
, uninterruptibleSetSocketOptionInt
, F.close
, F.uninterruptibleClose
, F.uninterruptibleErrorlessClose
, uninterruptibleShutdown
, send
, sendByteArray
, sendMutableByteArray
, uninterruptibleSend
, uninterruptibleSendByteArray
, uninterruptibleSendMutableByteArray
, uninterruptibleSendToByteArray
, uninterruptibleSendToMutableByteArray
, uninterruptibleSendToInternet
, uninterruptibleSendToInternetByteArray
, uninterruptibleSendToInternetMutableByteArray
#if defined(UNLIFTEDARRAYFUNCTIONS)
, writeVector
#endif
, receive
, receiveByteArray
, uninterruptibleReceive
, uninterruptibleReceiveMutableByteArray
, uninterruptibleReceiveFromMutableByteArray
, uninterruptibleReceiveFromMutableByteArray_
, uninterruptibleReceiveFrom_
, uninterruptibleReceiveFromInternet
, uninterruptibleReceiveFromInternetMutableByteArray
#if defined(UNLIFTEDARRAYFUNCTIONS)
, uninterruptibleReceiveMessageA
, uninterruptibleReceiveMessageB
#endif
, uninterruptibleSendMessageA
, uninterruptibleSendMessageB
#if defined(UNLIFTEDARRAYFUNCTIONS)
, uninterruptibleSendByteArrays
#endif
, hostToNetworkLong
, hostToNetworkShort
, networkToHostLong
, networkToHostShort
, Family(..)
, Type(..)
, Protocol(..)
, OptionName(..)
, OptionValue(..)
, Level(..)
, Message(..)
, MessageFlags(..)
, ShutdownType(..)
, AddressInfo
, SocketAddress(..)
, PST.SocketAddressInternet(..)
, PST.SocketAddressUnix(..)
, PSP.encodeSocketAddressInternet
, PSP.encodeSocketAddressUnix
, PSP.decodeSocketAddressInternet
, PSP.indexSocketAddressInternet
, PSP.sizeofSocketAddressInternet
, pattern PST.Unix
, pattern PST.Unspecified
, pattern PST.Internet
, pattern PST.Internet6
, PST.stream
, PST.datagram
, PST.raw
, PST.sequencedPacket
, PST.defaultProtocol
, PST.rawProtocol
, PST.icmp
, PST.tcp
, PST.udp
, PST.ip
, PST.ipv6
, PST.peek
, PST.outOfBand
, PST.waitAll
, PST.noSignal
, PST.read
, PST.write
, PST.readWrite
, PST.levelSocket
, PST.optionError
, PST.bindToDevice
, PST.broadcast
, PST.reuseAddress
, PST.peekAddressInfoFlags
, PST.pokeAddressInfoFlags
, PST.sizeofAddressInfo
, PST.peekMessageHeaderName
, PST.peekMessageHeaderNameLength
, PST.peekMessageHeaderIOVector
, PST.peekMessageHeaderIOVectorLength
, PST.peekMessageHeaderControl
, PST.peekMessageHeaderControlLength
, PST.peekMessageHeaderFlags
, PST.peekControlMessageHeaderLevel
, PST.peekControlMessageHeaderLength
, PST.peekControlMessageHeaderType
, PST.pokeMessageHeaderName
, PST.pokeMessageHeaderNameLength
, PST.pokeMessageHeaderIOVector
, PST.pokeMessageHeaderIOVectorLength
, PST.pokeMessageHeaderControl
, PST.pokeMessageHeaderControlLength
, PST.pokeMessageHeaderFlags
, PST.sizeofMessageHeader
, PST.peekIOVectorBase
, PST.peekIOVectorLength
, PST.pokeIOVectorBase
, PST.pokeIOVectorLength
, PST.sizeofIOVector
) where
import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder)
import GHC.IO (IO(..))
import Data.Primitive.Addr (Addr(..),plusAddr,nullAddr)
import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),ByteArray(..))
#if defined(UNLIFTEDARRAYFUNCTIONS)
import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray,UnliftedArray_(UnliftedArray))
import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray))
import Data.Primitive.Unlifted.Array.Primops (UnliftedArray#(UnliftedArray#),MutableUnliftedArray#)
#endif
import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..))
import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset(..))
import Data.Word (Word8,Word16,Word32,byteSwap16,byteSwap32)
import Data.Void (Void)
import Foreign.C.Error (Errno(Errno),getErrno)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..),CSize(..))
import Foreign.Ptr (nullPtr)
import GHC.Exts (Ptr(Ptr),RealWorld,ByteArray#,MutableByteArray#)
import GHC.Exts (Addr#,TYPE)
import GHC.Exts (Int(I#))
import GHC.Exts (shrinkMutableByteArray#,touch#)
import Posix.Socket.Types (Family(..),Protocol(..),Type(..),SocketAddress(..))
import Posix.Socket.Types (SocketAddressInternet(..))
import Posix.Socket.Types (MessageFlags(..),Message(..),ShutdownType(..))
import Posix.Socket.Types (Level(..),OptionName(..),OptionValue(..))
import Posix.Socket.Types (AddressInfo)
import System.Posix.Types (Fd(..),CSsize(..))
#if MIN_VERSION_base(4,16,0)
import GHC.Exts (RuntimeRep(BoxedRep),Levity(Unlifted))
#else
import GHC.Exts (RuntimeRep(UnliftedRep))
#endif
import qualified Posix.File as F
import qualified Posix.Socket.Types as PST
import qualified Data.Primitive as PM
#if defined(UNLIFTEDARRAYFUNCTIONS)
import qualified Data.Primitive.Unlifted.Array as PM
#endif
import qualified Control.Monad.Primitive as PM
import qualified GHC.Exts as Exts
import qualified Posix.Socket.Platform as PSP
foreign import ccall safe "sys/socket.h getaddrinfo"
c_safe_getaddrinfo ::
CString
-> CString
-> Ptr AddressInfo
-> MutableByteArray# RealWorld
-> IO Errno
foreign import ccall safe "sys/socket.h freeaddrinfo"
uninterruptibleFreeAddressInfo :: Ptr AddressInfo -> IO ()
foreign import ccall unsafe "sys/socket.h socket"
c_socket :: Family -> Type -> Protocol -> IO Fd
foreign import ccall unsafe "sys/socket.h socketpair"
c_socketpair :: Family -> Type -> Protocol -> MutableByteArray# RealWorld -> IO CInt
foreign import ccall unsafe "sys/socket.h listen"
c_listen :: Fd -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h shutdown"
c_unsafe_shutdown :: Fd -> ShutdownType -> IO CInt
foreign import ccall unsafe "sys/socket.h bind"
c_bind :: Fd -> ByteArray# -> CInt -> IO CInt
foreign import ccall safe "sys/socket.h accept"
c_safe_accept :: Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Fd
foreign import ccall unsafe "sys/socket.h accept"
c_unsafe_accept :: Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Fd
foreign import ccall safe "sys/socket.h accept"
c_safe_ptr_accept :: Fd -> Ptr Void -> Ptr CInt -> IO Fd
foreign import ccall unsafe "sys/socket.h getsockname"
c_unsafe_getsockname :: Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO CInt
foreign import ccall unsafe "sys/socket.h getsockopt"
c_unsafe_getsockopt :: Fd
-> Level
-> OptionName
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO CInt
foreign import ccall unsafe "sys/socket.h setsockopt_int"
c_unsafe_setsockopt_int :: Fd
-> Level
-> OptionName
-> CInt
-> IO CInt
foreign import ccall unsafe "sys/socket.h setsockopt"
c_unsafe_setsockopt :: Fd
-> Level
-> OptionName
-> Ptr Void
-> CInt
-> IO CInt
foreign import ccall unsafe "sys/socket.h setsockopt"
c_unsafe_setsockopt_ba :: Fd
-> Level
-> OptionName
-> ByteArray#
-> CInt
-> IO CInt
foreign import ccall safe "sys/socket.h connect"
c_safe_connect :: Fd -> ByteArray# -> CInt -> IO CInt
foreign import ccall safe "sys/socket.h connect"
c_safe_mutablebytearray_connect :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CInt
foreign import ccall unsafe "sys/socket.h connect"
c_unsafe_connect :: Fd -> ByteArray# -> CInt -> IO CInt
foreign import ccall unsafe "sys/socket.h connect"
c_unsafe_connect_addr :: Fd -> Addr# -> CInt -> IO CInt
foreign import ccall safe "sys/socket.h send"
c_safe_addr_send :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall safe "sys/socket.h send_offset"
c_safe_bytearray_send :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall safe "sys/socket.h send_offset"
c_safe_mutablebytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall safe "sys/socket.h send"
c_safe_mutablebytearray_no_offset_send :: Fd -> MutableByteArray# RealWorld -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall unsafe "sys/socket.h send"
c_unsafe_addr_send :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall unsafe "sys/socket.h send_offset"
c_unsafe_bytearray_send :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall unsafe "sys/socket.h send_offset"
c_unsafe_mutable_bytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall unsafe "sys/socket.h sendto_offset"
c_unsafe_bytearray_sendto :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize
foreign import ccall unsafe "sys/socket.h sendto_offset"
c_unsafe_mutable_bytearray_sendto :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize
foreign import ccall unsafe "sys/socket.h sendto_inet_offset"
c_unsafe_mutable_bytearray_sendto_inet :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h sendto_inet_offset"
c_unsafe_bytearray_sendto_inet :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h sendto_inet_addr"
c_unsafe_addr_sendto_inet :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h sendmsg_a"
c_unsafe_sendmsg_a :: Fd -> Addr# -> CSize -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
foreign import ccall unsafe "HaskellPosix.h sendmsg_b"
c_unsafe_sendmsg_b :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
#if defined(UNLIFTEDARRAYFUNCTIONS)
foreign import ccall unsafe "HaskellPosix.h sendmsg_bytearrays"
c_unsafe_sendmsg_bytearrays :: Fd -> UnliftedArray# ByteArray# -> Int -> Int -> Int -> MessageFlags 'Send -> IO CSsize
#endif
foreign import ccall safe "sys/uio.h writev"
c_safe_writev :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CSsize
foreign import ccall safe "sys/socket.h recv"
c_safe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
foreign import ccall unsafe "sys/socket.h recv"
c_unsafe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
foreign import ccall unsafe "sys/socket.h recv_offset"
c_unsafe_mutable_byte_array_recv :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Receive -> IO CSsize
foreign import ccall unsafe "sys/socket.h recvfrom_offset"
c_unsafe_mutable_byte_array_recvfrom :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Receive -> MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> IO CSsize
foreign import ccall unsafe "sys/socket.h recvfrom_offset_peerless"
c_unsafe_mutable_byte_array_peerless_recvfrom ::
Fd
-> MutableByteArray# RealWorld -> Int -> CSize
-> MessageFlags 'Receive -> IO CSsize
foreign import ccall unsafe "sys/socket.h recvfrom_addr_peerless"
c_unsafe_addr_peerless_recvfrom ::
Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet"
c_unsafe_recvfrom_inet ::
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet_addr"
c_unsafe_recvfrom_inet_addr ::
Fd
-> Addr#
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
foreign import ccall unsafe "sys/socket.h recvmsg"
c_unsafe_addr_recvmsg :: Fd
-> Addr#
-> MessageFlags 'Receive
-> IO CSsize
uninterruptibleSocket ::
Family
-> Type
-> Protocol
-> IO (Either Errno Fd)
uninterruptibleSocket :: Family -> Type -> Protocol -> IO (Either Errno Fd)
uninterruptibleSocket Family
dom Type
typ Protocol
prot = Family -> Type -> Protocol -> IO Fd
c_socket Family
dom Type
typ Protocol
prot forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleSocketPair ::
Family
-> Type
-> Protocol
-> IO (Either Errno (Fd,Fd))
uninterruptibleSocketPair :: Family -> Type -> Protocol -> IO (Either Errno (Fd, Fd))
uninterruptibleSocketPair Family
dom Type
typ Protocol
prot = do
(sockets :: MutablePrimArray RealWorld Fd
sockets@(MutablePrimArray MutableByteArray# RealWorld
sockets#) :: MutablePrimArray RealWorld Fd) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PM.newPrimArray Int
2
CInt
r <- Family
-> Type -> Protocol -> MutableByteArray# RealWorld -> IO CInt
c_socketpair Family
dom Type
typ Protocol
prot MutableByteArray# RealWorld
sockets#
if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then do
Fd
fd1 <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray RealWorld Fd
sockets Int
0
Fd
fd2 <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray RealWorld Fd
sockets Int
1
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Fd
fd1,Fd
fd2))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
getAddressInfo ::
CString
-> CString
-> Ptr AddressInfo
-> IO (Either Errno (Ptr AddressInfo))
getAddressInfo :: CString
-> CString
-> Ptr AddressInfo
-> IO (Either Errno (Ptr AddressInfo))
getAddressInfo !CString
node !CString
service !Ptr AddressInfo
hints = do
resBuf :: MutableByteArray RealWorld
resBuf@(MutableByteArray MutableByteArray# RealWorld
resBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: Ptr ()))
CString
-> CString
-> Ptr AddressInfo
-> MutableByteArray# RealWorld
-> IO Errno
c_safe_getaddrinfo CString
node CString
service Ptr AddressInfo
hints MutableByteArray# RealWorld
resBuf# forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Errno CInt
0 -> do
Ptr AddressInfo
res <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
resBuf Int
0
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Ptr AddressInfo
res)
Errno
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Errno
e)
uninterruptibleBind ::
Fd
-> SocketAddress
-> IO (Either Errno ())
uninterruptibleBind :: Fd -> SocketAddress -> IO (Either Errno ())
uninterruptibleBind Fd
fd (SocketAddress b :: ByteArray
b@(ByteArray ByteArray#
b#)) =
Fd -> ByteArray# -> CInt -> IO CInt
c_bind Fd
fd ByteArray#
b# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
b)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleListen ::
Fd
-> CInt
-> IO (Either Errno ())
uninterruptibleListen :: Fd -> CInt -> IO (Either Errno ())
uninterruptibleListen Fd
fd CInt
backlog = Fd -> CInt -> IO CInt
c_listen Fd
fd CInt
backlog forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
connect ::
Fd
-> SocketAddress
-> IO (Either Errno ())
connect :: Fd -> SocketAddress -> IO (Either Errno ())
connect Fd
fd (SocketAddress sockAddr :: ByteArray
sockAddr@(ByteArray ByteArray#
sockAddr#)) =
case ByteArray -> Bool
isByteArrayPinned ByteArray
sockAddr of
Bool
True -> Fd -> ByteArray# -> CInt -> IO CInt
c_safe_connect Fd
fd ByteArray#
sockAddr# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
sockAddr)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
Bool
False -> do
let len :: Int
len = ByteArray -> Int
PM.sizeofByteArray ByteArray
sockAddr
x :: MutableByteArray RealWorld
x@(MutableByteArray MutableByteArray# RealWorld
x#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
len
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
x Int
0 ByteArray
sockAddr Int
0 Int
len
Fd -> MutableByteArray# RealWorld -> CInt -> IO CInt
c_safe_mutablebytearray_connect Fd
fd MutableByteArray# RealWorld
x# (Int -> CInt
intToCInt Int
len) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleConnect ::
Fd
-> SocketAddress
-> IO (Either Errno ())
uninterruptibleConnect :: Fd -> SocketAddress -> IO (Either Errno ())
uninterruptibleConnect Fd
fd (SocketAddress sockAddr :: ByteArray
sockAddr@(ByteArray ByteArray#
sockAddr#)) =
Fd -> ByteArray# -> CInt -> IO CInt
c_unsafe_connect Fd
fd ByteArray#
sockAddr# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
sockAddr)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleConnectPtr ::
Fd
-> Ptr a
-> Int
-> IO (Either Errno ())
uninterruptibleConnectPtr :: forall a. Fd -> Ptr a -> Int -> IO (Either Errno ())
uninterruptibleConnectPtr !Fd
fd (Ptr Addr#
sockAddr#) !Int
sz =
Fd -> Addr# -> CInt -> IO CInt
c_unsafe_connect_addr Fd
fd Addr#
sockAddr# (Int -> CInt
intToCInt Int
sz) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
accept ::
Fd
-> CInt
-> IO (Either Errno (CInt,SocketAddress,Fd))
accept :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress, Fd))
accept !Fd
sock !CInt
maxSz = do
sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CInt -> Int
cintToInt CInt
maxSz)
lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
lenBuf Int
0 CInt
maxSz
Fd
r <- Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Fd
c_safe_accept Fd
sock MutableByteArray# RealWorld
sockAddrBuf# MutableByteArray# RealWorld
lenBuf#
if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then do
(CInt
sz :: CInt) <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
lenBuf Int
0
let minSz :: CInt
minSz = forall a. Ord a => a -> a -> a
min CInt
sz CInt
maxSz
MutableByteArray RealWorld
x <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
minSz)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
x Int
0 MutableByteArray RealWorld
sockAddrBuf Int
0 (CInt -> Int
cintToInt CInt
minSz)
ByteArray
sockAddr <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CInt
sz,ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr,Fd
r))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleAccept ::
Fd
-> CInt
-> IO (Either Errno (CInt,SocketAddress,Fd))
uninterruptibleAccept :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress, Fd))
uninterruptibleAccept !Fd
sock !CInt
maxSz = do
sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
lenBuf Int
0 CInt
maxSz
Fd
r <- Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Fd
c_unsafe_accept Fd
sock MutableByteArray# RealWorld
sockAddrBuf# MutableByteArray# RealWorld
lenBuf#
if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then do
(CInt
sz :: CInt) <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
lenBuf Int
0
if CInt
sz forall a. Ord a => a -> a -> Bool
< CInt
maxSz
then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ByteArray
sockAddr <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
sockAddrBuf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CInt
sz,ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr,Fd
r))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
accept_ ::
Fd
-> IO (Either Errno Fd)
accept_ :: Fd -> IO (Either Errno Fd)
accept_ Fd
sock =
Fd -> Ptr Void -> Ptr CInt -> IO Fd
c_safe_ptr_accept Fd
sock forall a. Ptr a
nullPtr forall a. Ptr a
nullPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleGetSocketName ::
Fd
-> CInt
-> IO (Either Errno (CInt,SocketAddress))
uninterruptibleGetSocketName :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress))
uninterruptibleGetSocketName Fd
sock CInt
maxSz = do
sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
lenBuf Int
0 CInt
maxSz
CInt
r <- Fd
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO CInt
c_unsafe_getsockname Fd
sock MutableByteArray# RealWorld
sockAddrBuf# MutableByteArray# RealWorld
lenBuf#
if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then do
(CInt
sz :: CInt) <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
lenBuf Int
0
if CInt
sz forall a. Ord a => a -> a -> Bool
< CInt
maxSz
then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ByteArray
sockAddr <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
sockAddrBuf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CInt
sz,ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleGetSocketOption ::
Fd
-> Level
-> OptionName
-> CInt
-> IO (Either Errno (CInt,OptionValue))
uninterruptibleGetSocketOption :: Fd
-> Level
-> OptionName
-> CInt
-> IO (Either Errno (CInt, OptionValue))
uninterruptibleGetSocketOption Fd
sock Level
level OptionName
optName CInt
maxSz = do
valueBuf :: MutableByteArray RealWorld
valueBuf@(MutableByteArray MutableByteArray# RealWorld
valueBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
lenBuf Int
0 CInt
maxSz
CInt
r <- Fd
-> Level
-> OptionName
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO CInt
c_unsafe_getsockopt Fd
sock Level
level OptionName
optName MutableByteArray# RealWorld
valueBuf# MutableByteArray# RealWorld
lenBuf#
if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then do
(CInt
sz :: CInt) <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
lenBuf Int
0
if CInt
sz forall a. Ord a => a -> a -> Bool
< CInt
maxSz
then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
valueBuf (CInt -> Int
cintToInt CInt
sz)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ByteArray
value <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
valueBuf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CInt
sz,ByteArray -> OptionValue
OptionValue ByteArray
value))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleSetSocketOptionInt ::
Fd
-> Level
-> OptionName
-> CInt
-> IO (Either Errno ())
uninterruptibleSetSocketOptionInt :: Fd -> Level -> OptionName -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOptionInt Fd
sock Level
level OptionName
optName CInt
optValue =
Fd -> Level -> OptionName -> CInt -> IO CInt
c_unsafe_setsockopt_int Fd
sock Level
level OptionName
optName CInt
optValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleSetSocketOption ::
Fd
-> Level
-> OptionName
-> Ptr Void
-> CInt
-> IO (Either Errno ())
uninterruptibleSetSocketOption :: Fd
-> Level -> OptionName -> Ptr Void -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOption Fd
sock Level
level OptionName
optName Ptr Void
optValue CInt
optLen =
Fd -> Level -> OptionName -> Ptr Void -> CInt -> IO CInt
c_unsafe_setsockopt Fd
sock Level
level OptionName
optName Ptr Void
optValue CInt
optLen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
uninterruptibleSetSocketOptionByteArray ::
Fd
-> Level
-> OptionName
-> ByteArray
-> CInt
-> IO (Either Errno ())
uninterruptibleSetSocketOptionByteArray :: Fd
-> Level -> OptionName -> ByteArray -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOptionByteArray Fd
sock Level
level OptionName
optName (ByteArray ByteArray#
optVal) CInt
optLen =
Fd -> Level -> OptionName -> ByteArray# -> CInt -> IO CInt
c_unsafe_setsockopt_ba Fd
sock Level
level OptionName
optName ByteArray#
optVal CInt
optLen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
sendByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendByteArray Fd
fd b :: ByteArray
b@(ByteArray ByteArray#
b#) Int
off CSize
len MessageFlags 'Send
flags = if ByteArray -> Bool
isByteArrayPinned ByteArray
b
then CSsize -> IO (Either Errno CSize)
errorsFromSize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
c_safe_bytearray_send Fd
fd ByteArray#
b# Int
off CSize
len MessageFlags 'Send
flags
else do
x :: MutableByteArray RealWorld
x@(MutableByteArray MutableByteArray# RealWorld
x#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
x Int
off ByteArray
b Int
0 (CSize -> Int
csizeToInt CSize
len)
CSsize -> IO (Either Errno CSize)
errorsFromSize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fd
-> MutableByteArray# RealWorld
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_safe_mutablebytearray_no_offset_send Fd
fd MutableByteArray# RealWorld
x# CSize
len MessageFlags 'Send
flags
#if MIN_VERSION_base(4,16,0)
data UList (a :: TYPE ('BoxedRep 'Unlifted)) where
#else
data UList (a :: TYPE 'UnliftedRep) where
#endif
UNil :: UList a
UCons :: a -> UList a -> UList a
foldDownward :: forall a. Int -> a -> (a -> Int -> IO a) -> IO a
{-# INLINE foldDownward #-}
foldDownward :: forall a. Int -> a -> (a -> Int -> IO a) -> IO a
foldDownward !Int
hi !a
a0 a -> Int -> IO a
f = Int -> a -> IO a
go (Int
hi forall a. Num a => a -> a -> a
- Int
1) a
a0 where
go :: Int -> a -> IO a
go :: Int -> a -> IO a
go !Int
ix !a
a = if Int
ix forall a. Ord a => a -> a -> Bool
>= Int
0
then a -> Int -> IO a
f a
a Int
ix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> IO a
go (Int
ix forall a. Num a => a -> a -> a
- Int
1)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
pinByteArray :: ByteArray -> IO (Maybe ByteArray)
{-# INLINE pinByteArray #-}
pinByteArray :: ByteArray -> IO (Maybe ByteArray)
pinByteArray ByteArray
byteArray =
if ByteArray -> Bool
isByteArrayPinned ByteArray
byteArray
then
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else do
MutableByteArray RealWorld
pinnedByteArray <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
len
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
pinnedByteArray Int
0 ByteArray
byteArray Int
0 Int
len
ByteArray
r <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
pinnedByteArray
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just ByteArray
r)
where
len :: Int
len = ByteArray -> Int
PM.sizeofByteArray ByteArray
byteArray
uninterruptibleSendMessageA ::
Fd
-> Addr
-> CSize
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageA :: Fd
-> Addr
-> CSize
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageA Fd
fd (Addr Addr#
addr) CSize
lenA
(MutableByteArrayOffset{MutableByteArray RealWorld
$sel:array:MutableByteArrayOffset :: forall s. MutableByteArrayOffset s -> MutableByteArray s
array :: MutableByteArray RealWorld
array,Int
$sel:offset:MutableByteArrayOffset :: forall s. MutableByteArrayOffset s -> Int
offset :: Int
offset}) CSize
lenB MessageFlags 'Send
flags =
Fd
-> Addr#
-> CSize
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_unsafe_sendmsg_a Fd
fd Addr#
addr CSize
lenA (forall s. MutableByteArray s -> MutableByteArray# s
unMba MutableByteArray RealWorld
array) Int
offset CSize
lenB MessageFlags 'Send
flags
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendMessageB ::
Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> Addr
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageB :: Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> Addr
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageB Fd
fd
(MutableByteArrayOffset{MutableByteArray RealWorld
array :: MutableByteArray RealWorld
$sel:array:MutableByteArrayOffset :: forall s. MutableByteArrayOffset s -> MutableByteArray s
array,Int
offset :: Int
$sel:offset:MutableByteArrayOffset :: forall s. MutableByteArrayOffset s -> Int
offset}) CSize
lenB
(Addr Addr#
addr) CSize
lenA MessageFlags 'Send
flags =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> Addr#
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_unsafe_sendmsg_b Fd
fd (forall s. MutableByteArray s -> MutableByteArray# s
unMba MutableByteArray RealWorld
array) Int
offset CSize
lenB Addr#
addr CSize
lenA MessageFlags 'Send
flags
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
sendMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendMutableByteArray Fd
fd b :: MutableByteArray RealWorld
b@(MutableByteArray MutableByteArray# RealWorld
b#) Int
off CSize
len MessageFlags 'Send
flags = if forall s. MutableByteArray s -> Bool
isMutableByteArrayPinned MutableByteArray RealWorld
b
then CSsize -> IO (Either Errno CSize)
errorsFromSize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_safe_mutablebytearray_send Fd
fd MutableByteArray# RealWorld
b# Int
off CSize
len MessageFlags 'Send
flags
else do
x :: MutableByteArray RealWorld
x@(MutableByteArray MutableByteArray# RealWorld
x#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
x Int
off MutableByteArray RealWorld
b Int
0 (CSize -> Int
csizeToInt CSize
len)
CSsize -> IO (Either Errno CSize)
errorsFromSize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fd
-> MutableByteArray# RealWorld
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_safe_mutablebytearray_no_offset_send Fd
fd MutableByteArray# RealWorld
x# CSize
len MessageFlags 'Send
flags
send ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
send :: Fd
-> Addr -> CSize -> MessageFlags 'Send -> IO (Either Errno CSize)
send Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Send
flags =
Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
c_safe_addr_send Fd
fd Addr#
addr CSize
len MessageFlags 'Send
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSend ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSend :: Fd
-> Addr -> CSize -> MessageFlags 'Send -> IO (Either Errno CSize)
uninterruptibleSend Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Send
flags =
Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
c_unsafe_addr_send Fd
fd Addr#
addr CSize
len MessageFlags 'Send
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags =
Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
c_unsafe_bytearray_send Fd
fd ByteArray#
b Int
off CSize
len MessageFlags 'Send
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_unsafe_mutable_bytearray_send Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Send
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendToByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddress a :: ByteArray
a@(ByteArray ByteArray#
a#)) =
Fd
-> ByteArray#
-> Int
-> CSize
-> MessageFlags 'Send
-> ByteArray#
-> CInt
-> IO CSsize
c_unsafe_bytearray_sendto Fd
fd ByteArray#
b Int
off CSize
len MessageFlags 'Send
flags ByteArray#
a# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendToInternetByteArray ::
Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddressInternet{Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port :: Word16
port,Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address :: Word32
address}) =
Fd
-> ByteArray#
-> Int
-> CSize
-> MessageFlags 'Send
-> Word16
-> Word32
-> IO CSsize
c_unsafe_bytearray_sendto_inet Fd
fd ByteArray#
b Int
off CSize
len MessageFlags 'Send
flags Word16
port Word32
address forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendToInternet ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternet :: Fd
-> Addr
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternet Fd
fd (Addr Addr#
b) CSize
len MessageFlags 'Send
flags (SocketAddressInternet{Word16
port :: Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port,Word32
address :: Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address}) =
Fd
-> Addr#
-> CSize
-> MessageFlags 'Send
-> Word16
-> Word32
-> IO CSsize
c_unsafe_addr_sendto_inet Fd
fd Addr#
b CSize
len MessageFlags 'Send
flags Word16
port Word32
address forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendToMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddress a :: ByteArray
a@(ByteArray ByteArray#
a#)) =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> ByteArray#
-> CInt
-> IO CSsize
c_unsafe_mutable_bytearray_sendto Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Send
flags ByteArray#
a# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleSendToInternetMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddressInternet{Word16
port :: Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port,Word32
address :: Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address}) =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> Word16
-> Word32
-> IO CSsize
c_unsafe_mutable_bytearray_sendto_inet Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Send
flags Word16
port Word32
address forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
receive ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
receive :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
receive Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Receive
flags =
Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_safe_addr_recv Fd
fd Addr#
addr CSize
len MessageFlags 'Receive
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
receiveByteArray ::
Fd
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno ByteArray)
receiveByteArray :: Fd -> CSize -> MessageFlags 'Receive -> IO (Either Errno ByteArray)
receiveByteArray !Fd
fd !CSize
len !MessageFlags 'Receive
flags = do
MutableByteArray RealWorld
m <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
let !(Addr Addr#
addr) = Ptr Word8 -> Addr
ptrToAddr (forall s. MutableByteArray s -> Ptr Word8
PM.mutableByteArrayContents MutableByteArray RealWorld
m)
CSsize
r <- Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_safe_addr_recv Fd
fd Addr#
addr CSize
len MessageFlags 'Receive
flags
if CSsize
r forall a. Eq a => a -> a -> Bool
/= (-CSsize
1)
then do
let sz :: Int
sz = CSsize -> Int
cssizeToInt CSsize
r
MutableByteArray RealWorld
x <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
sz
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
x Int
0 MutableByteArray RealWorld
m Int
0 Int
sz
ByteArray
a <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ByteArray
a)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleReceive ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceive #-}
uninterruptibleReceive :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceive !Fd
fd (Addr !Addr#
addr) !CSize
len !MessageFlags 'Receive
flags =
Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_unsafe_addr_recv Fd
fd Addr#
addr CSize
len MessageFlags 'Receive
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleReceiveMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceiveMutableByteArray #-}
uninterruptibleReceiveMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveMutableByteArray !Fd
fd (MutableByteArray !MutableByteArray# RealWorld
b) !Int
off !CSize
len !MessageFlags 'Receive
flags =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO CSsize
c_unsafe_mutable_byte_array_recv Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleReceiveFromMutableByteArray ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> CInt
-> IO (Either Errno (CInt,SocketAddress,CSize))
{-# inline uninterruptibleReceiveFromMutableByteArray #-}
uninterruptibleReceiveFromMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> CInt
-> IO (Either Errno (CInt, SocketAddress, CSize))
uninterruptibleReceiveFromMutableByteArray !Fd
fd (MutableByteArray !MutableByteArray# RealWorld
b) !Int
off !CSize
len !MessageFlags 'Receive
flags !CInt
maxSz = do
sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (forall a. Prim a => a -> Int
PM.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
lenBuf Int
0 CInt
maxSz
CSsize
r <- Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO CSsize
c_unsafe_mutable_byte_array_recvfrom Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags MutableByteArray# RealWorld
sockAddrBuf# MutableByteArray# RealWorld
lenBuf#
if CSsize
r forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
then do
(CInt
sz :: CInt) <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
lenBuf Int
0
if CInt
sz forall a. Ord a => a -> a -> Bool
< CInt
maxSz
then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ByteArray
sockAddr <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
sockAddrBuf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CInt
sz,ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr,CSsize -> CSize
cssizeToCSize CSsize
r))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
uninterruptibleReceiveFromInternet ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceiveFromInternet #-}
uninterruptibleReceiveFromInternet :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleReceiveFromInternet !Fd
fd
(Addr Addr#
b) !CSize
len !MessageFlags 'Receive
flags
(MutablePrimArrayOffset (MutablePrimArray MutableByteArray# RealWorld
sockAddrBuf) Int
addrOff) =
Fd
-> Addr#
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
c_unsafe_recvfrom_inet_addr Fd
fd Addr#
b CSize
len MessageFlags 'Receive
flags MutableByteArray# RealWorld
sockAddrBuf Int
addrOff
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleReceiveFromInternetMutableByteArray ::
Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceiveFromInternetMutableByteArray #-}
uninterruptibleReceiveFromInternetMutableByteArray :: Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleReceiveFromInternetMutableByteArray !Fd
fd
(MutableByteArrayOffset (MutableByteArray MutableByteArray# RealWorld
b) Int
off) !CSize
len !MessageFlags 'Receive
flags
(MutablePrimArrayOffset (MutablePrimArray MutableByteArray# RealWorld
sockAddrBuf) Int
addrOff) =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
c_unsafe_recvfrom_inet Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags MutableByteArray# RealWorld
sockAddrBuf Int
addrOff
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleReceiveFromMutableByteArray_ ::
Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceiveFromMutableByteArray_ #-}
uninterruptibleReceiveFromMutableByteArray_ :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveFromMutableByteArray_ !Fd
fd (MutableByteArray !MutableByteArray# RealWorld
b) !Int
off !CSize
len !MessageFlags 'Receive
flags =
Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO CSsize
c_unsafe_mutable_byte_array_peerless_recvfrom Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
uninterruptibleReceiveFrom_ ::
Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
{-# inline uninterruptibleReceiveFrom_ #-}
uninterruptibleReceiveFrom_ :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveFrom_ !Fd
fd (Addr !Addr#
b) !CSize
len !MessageFlags 'Receive
flags =
Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_unsafe_addr_peerless_recvfrom Fd
fd Addr#
b CSize
len MessageFlags 'Receive
flags
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize
ptrToAddr :: Ptr Word8 -> Addr
ptrToAddr :: Ptr Word8 -> Addr
ptrToAddr (Exts.Ptr Addr#
a) = Addr# -> Addr
Addr Addr#
a
uninterruptibleShutdown ::
Fd
-> ShutdownType
-> IO (Either Errno ())
uninterruptibleShutdown :: Fd -> ShutdownType -> IO (Either Errno ())
uninterruptibleShutdown Fd
fd ShutdownType
typ =
Fd -> ShutdownType -> IO CInt
c_unsafe_shutdown Fd
fd ShutdownType
typ forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize CSsize
r = if CSsize
r forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (CSsize -> CSize
cssizeToCSize CSsize
r))
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd Fd
r = if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Fd
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ CInt
r = if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
intToCInt :: Int -> CInt
intToCInt :: Int -> CInt
intToCInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral
cintToInt :: CInt -> Int
cintToInt :: CInt -> Int
cintToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
csizeToInt :: CSize -> Int
csizeToInt :: CSize -> Int
csizeToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
cssizeToInt :: CSsize -> Int
cssizeToInt :: CSsize -> Int
cssizeToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
cssizeToCSize :: CSsize -> CSize
cssizeToCSize :: CSsize -> CSize
cssizeToCSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral
shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray (MutableByteArray MutableByteArray# RealWorld
arr) (I# Int#
sz) =
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
PM.primitive_ (forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# RealWorld
arr Int#
sz)
hostToNetworkShort :: Word16 -> Word16
hostToNetworkShort :: Word16 -> Word16
hostToNetworkShort = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16
networkToHostShort :: Word16 -> Word16
networkToHostShort :: Word16 -> Word16
networkToHostShort = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16
hostToNetworkLong :: Word32 -> Word32
hostToNetworkLong :: Word32 -> Word32
hostToNetworkLong = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32
networkToHostLong :: Word32 -> Word32
networkToHostLong :: Word32 -> Word32
networkToHostLong = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32
pokeMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> IO ()
Addr
msgHdrAddr Addr
a CInt
b Addr
c CSize
d Addr
e CSize
f MessageFlags 'Receive
g = do
Addr -> Addr -> IO ()
PST.pokeMessageHeaderName Addr
msgHdrAddr Addr
a
Addr -> CInt -> IO ()
PST.pokeMessageHeaderNameLength Addr
msgHdrAddr CInt
b
Addr -> Addr -> IO ()
PST.pokeMessageHeaderIOVector Addr
msgHdrAddr Addr
c
Addr -> CSize -> IO ()
PST.pokeMessageHeaderIOVectorLength Addr
msgHdrAddr CSize
d
Addr -> Addr -> IO ()
PST.pokeMessageHeaderControl Addr
msgHdrAddr Addr
e
Addr -> CSize -> IO ()
PST.pokeMessageHeaderControlLength Addr
msgHdrAddr CSize
f
Addr -> MessageFlags 'Receive -> IO ()
PST.pokeMessageHeaderFlags Addr
msgHdrAddr MessageFlags 'Receive
g
#if defined(UNLIFTEDARRAYFUNCTIONS)
writeVector ::
Fd
-> UnliftedArray ByteArray
-> IO (Either Errno CSize)
writeVector fd buffers = do
iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <-
PM.newPinnedByteArray
(cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)
newBufs <- foldDownward (PM.sizeofUnliftedArray buffers) UNil $ \newBufs i -> do
let !buf = PM.indexUnliftedArray buffers i
pinByteArray buf >>= \case
Nothing -> do
let buffer = buf
let targetAddr :: Addr
targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`
(i * cintToInt PST.sizeofIOVector)
PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))
PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))
pure newBufs
Just buffer -> do
let targetAddr :: Addr
targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`
(i * cintToInt PST.sizeofIOVector)
PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))
PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))
pure (UCons (unByteArray buffer) newBufs)
r <- errorsFromSize =<<
c_safe_writev fd iovecs# (intToCInt (PM.sizeofUnliftedArray buffers))
touchUnliftedArray buffers
touchLifted newBufs
pure r
uninterruptibleSendByteArrays ::
Fd
-> UnliftedArray ByteArray
-> Int
-> Int
-> Int
-> MessageFlags 'Send
-> IO (Either Errno CSize)
{-# inline uninterruptibleSendByteArrays #-}
uninterruptibleSendByteArrays !fd (UnliftedArray arrs)
off !len !offC !flags =
c_unsafe_sendmsg_bytearrays fd arrs off len offC flags
>>= errorsFromSize
uninterruptibleReceiveMessageA ::
Fd
-> CSize
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno (CSize,UnliftedArray ByteArray))
uninterruptibleReceiveMessageA !s !chunkSize !chunkCount !flags = do
bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)
iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)
let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)
initializeIOVectors bufs iovecsAddr chunkSize chunkCount
msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)
let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)
pokeMessageHeader msgHdrAddr nullAddr 0 iovecsAddr chunkCount nullAddr 0 flags
r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags
if r > (-1)
then do
filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs
frozenBufs <- deepFreezeIOVectors filled bufs
touchMutableUnliftedArray bufs
touchMutableByteArray iovecsBuf
touchMutableByteArray msgHdrBuf
pure (Right (cssizeToCSize r,frozenBufs))
else do
touchMutableUnliftedArray bufs
touchMutableByteArray iovecsBuf
touchMutableByteArray msgHdrBuf
fmap Left getErrno
uninterruptibleReceiveMessageB ::
Fd
-> CSize
-> CSize
-> MessageFlags 'Receive
-> CInt
-> IO (Either Errno (CInt,SocketAddress,CSize,UnliftedArray ByteArray))
uninterruptibleReceiveMessageB !s !chunkSize !chunkCount !flags !maxSockAddrSz = do
sockAddrBuf <- PM.newPinnedByteArray (cintToInt maxSockAddrSz)
bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)
iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)
let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)
initializeIOVectors bufs iovecsAddr chunkSize chunkCount
msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)
let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)
pokeMessageHeader msgHdrAddr
(ptrToAddr (PM.mutableByteArrayContents sockAddrBuf)) maxSockAddrSz iovecsAddr
chunkCount nullAddr 0 flags
r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags
if r > (-1)
then do
actualSockAddrSz <- PST.peekMessageHeaderNameLength msgHdrAddr
if actualSockAddrSz < maxSockAddrSz
then shrinkMutableByteArray sockAddrBuf (cintToInt actualSockAddrSz)
else pure ()
sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf
filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs
frozenBufs <- deepFreezeIOVectors filled bufs
touchMutableUnliftedArray bufs
touchMutableByteArray iovecsBuf
touchMutableByteArray msgHdrBuf
touchMutableByteArray sockAddrBuf
pure (Right (actualSockAddrSz,SocketAddress sockAddr,cssizeToCSize r,frozenBufs))
else do
touchMutableUnliftedArray bufs
touchMutableByteArray iovecsBuf
touchMutableByteArray msgHdrBuf
touchMutableByteArray sockAddrBuf
fmap Left getErrno
initializeIOVectors ::
MutableUnliftedArray RealWorld (MutableByteArray RealWorld)
-> Addr
-> CSize
-> CSize
-> IO ()
initializeIOVectors bufs iovecsAddr chunkSize chunkCount =
let go !ix !iovecAddr = if ix < csizeToInt chunkCount
then do
initializeIOVector bufs iovecAddr chunkSize ix
go (ix + 1) (plusAddr iovecAddr (cintToInt PST.sizeofIOVector))
else pure ()
in go 0 iovecsAddr
initializeIOVector ::
MutableUnliftedArray RealWorld (MutableByteArray RealWorld)
-> Addr
-> CSize
-> Int
-> IO ()
initializeIOVector bufs iovecAddr chunkSize ix = do
buf <- PM.newPinnedByteArray (csizeToInt chunkSize)
PM.writeUnliftedArray bufs ix buf
let !(Exts.Ptr bufAddr#) = PM.mutableByteArrayContents buf
bufAddr = Addr bufAddr#
PST.pokeIOVectorBase iovecAddr bufAddr
PST.pokeIOVectorLength iovecAddr chunkSize
countAndShrinkIOVectors ::
Int
-> Int
-> Int
-> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)
-> IO Int
countAndShrinkIOVectors !n !totalUsedSz !maxBufSz !bufs = go 0 totalUsedSz where
go !ix !remainingBytes = if ix < n
then if remainingBytes >= maxBufSz
then go
(ix + 1)
(remainingBytes - maxBufSz)
else if remainingBytes == 0
then pure ix
else do
buf <- PM.readUnliftedArray bufs ix
shrinkMutableByteArray buf remainingBytes
pure (ix + 1)
else pure ix
deepFreezeIOVectors ::
Int
-> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)
-> IO (UnliftedArray ByteArray)
deepFreezeIOVectors n m = do
x <- PM.unsafeNewUnliftedArray n
let go !ix = if ix < n
then do
PM.writeUnliftedArray x ix =<< PM.unsafeFreezeByteArray =<< PM.readUnliftedArray m ix
go (ix + 1)
else PM.unsafeFreezeUnliftedArray x
go 0
touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO ()
touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x
touchUnliftedArray :: UnliftedArray a -> IO ()
touchUnliftedArray (UnliftedArray x) = touchUnliftedArray# x
touchMutableUnliftedArray# :: MutableUnliftedArray# RealWorld a -> IO ()
touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)
touchUnliftedArray# :: UnliftedArray# a -> IO ()
touchUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)
#endif
unByteArray :: ByteArray -> ByteArray#
unByteArray :: ByteArray -> ByteArray#
unByteArray (ByteArray ByteArray#
x) = ByteArray#
x
touchMutableByteArray :: MutableByteArray RealWorld -> IO ()
touchMutableByteArray :: MutableByteArray RealWorld -> IO ()
touchMutableByteArray (MutableByteArray MutableByteArray# RealWorld
x) = MutableByteArray# RealWorld -> IO ()
touchMutableByteArray# MutableByteArray# RealWorld
x
touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()
touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()
touchMutableByteArray# MutableByteArray# RealWorld
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case touch# :: forall a. a -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
x State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #)
touchLifted :: a -> IO ()
touchLifted :: forall a. a -> IO ()
touchLifted a
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case touch# :: forall a. a -> State# RealWorld -> State# RealWorld
touch# a
x State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #)
isByteArrayPinned :: ByteArray -> Bool
{-# inline isByteArrayPinned #-}
isByteArrayPinned :: ByteArray -> Bool
isByteArrayPinned (ByteArray ByteArray#
arr#) =
Int# -> Bool
Exts.isTrue# (ByteArray# -> Int#
Exts.isByteArrayPinned# ByteArray#
arr#)
isMutableByteArrayPinned :: MutableByteArray s -> Bool
{-# inline isMutableByteArrayPinned #-}
isMutableByteArrayPinned :: forall s. MutableByteArray s -> Bool
isMutableByteArrayPinned (MutableByteArray MutableByteArray# s
marr#) =
Int# -> Bool
Exts.isTrue# (forall d. MutableByteArray# d -> Int#
Exts.isMutableByteArrayPinned# MutableByteArray# s
marr#)
unMba :: MutableByteArray s -> MutableByteArray# s
{-# inline unMba #-}
unMba :: forall s. MutableByteArray s -> MutableByteArray# s
unMba (MutableByteArray MutableByteArray# s
x) = MutableByteArray# s
x