{-# 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 #-}

-- | Types and functions related to the POSIX sockets API.
--   Unusual characteristics:
--
--   * Any time the standard calls for @socklen_t@, we use
--     @CInt@ instead. Linus Torvalds <https://yarchive.net/comp/linux/socklen_t.html writes>
--     that \"Any sane library must have @socklen_t@ be the same size as @int@.
--     Anything else breaks any BSD socket layer stuff.\"
--   * Send and receive each have several variants. They are distinguished by
--     the safe\/unsafe FFI use and by the @Addr@\/@ByteArray@/@MutableByteArray@
--     buffer type. They all call @send@ or @recv@ exactly once. They do not
--     repeatedly make syscalls like some of the functions in @network@.
--     Users who want that behavior need to build on top of this package.
--   * There are no requirements on the pinnedness of @ByteArray@ arguments
--     passed to any of these functions. If wrappers of the safe FFI are
--     passed unpinned @ByteArray@ arguments, they will copy the contents
--     into pinned memory before invoking the foreign function.
module Posix.Socket
  ( -- * Functions
    -- ** Socket
    uninterruptibleSocket
    -- ** Socket Pair
  , uninterruptibleSocketPair
    -- ** Address Resolution
  , getAddressInfo
  , uninterruptibleFreeAddressInfo
    -- ** Bind
  , uninterruptibleBind
    -- ** Connect
  , connect
  , uninterruptibleConnect
  , uninterruptibleConnectPtr
    -- ** Listen
  , uninterruptibleListen
    -- ** Accept
  , accept
  , uninterruptibleAccept
  , accept_
    -- ** Get Socket Name
  , uninterruptibleGetSocketName
    -- ** Get Socket Option
  , uninterruptibleGetSocketOption
    -- ** Set Socket Option
  , uninterruptibleSetSocketOption
  , uninterruptibleSetSocketOptionByteArray
  , uninterruptibleSetSocketOptionInt
    -- ** Close
  , F.close
  , F.uninterruptibleClose
  , F.uninterruptibleErrorlessClose
    -- ** Shutdown
  , uninterruptibleShutdown
    -- ** Send
  , send
  , sendByteArray
  , sendMutableByteArray
  , uninterruptibleSend
  , uninterruptibleSendByteArray
  , uninterruptibleSendMutableByteArray
    -- ** Send To
  , uninterruptibleSendToByteArray
  , uninterruptibleSendToMutableByteArray
  , uninterruptibleSendToInternet
  , uninterruptibleSendToInternetByteArray
  , uninterruptibleSendToInternetMutableByteArray
    -- ** Write Vector
#if defined(UNLIFTEDARRAYFUNCTIONS)
  , writeVector
#endif
    -- ** Receive
  , receive
  , receiveByteArray
  , uninterruptibleReceive
  , uninterruptibleReceiveMutableByteArray
    -- ** Receive From
  , uninterruptibleReceiveFromMutableByteArray
  , uninterruptibleReceiveFromMutableByteArray_
  , uninterruptibleReceiveFrom_
  , uninterruptibleReceiveFromInternet
  , uninterruptibleReceiveFromInternetMutableByteArray
    -- ** Receive Message
    -- $receiveMessage
#if defined(UNLIFTEDARRAYFUNCTIONS)
  , uninterruptibleReceiveMessageA
  , uninterruptibleReceiveMessageB
#endif
    -- ** Send Message
  , uninterruptibleSendMessageA
  , uninterruptibleSendMessageB
#if defined(UNLIFTEDARRAYFUNCTIONS)
  , uninterruptibleSendByteArrays
#endif
    -- ** Byte-Order Conversion
    -- $conversion
  , hostToNetworkLong
  , hostToNetworkShort
  , networkToHostLong
  , networkToHostShort
    -- * Types
  , Family(..)
  , Type(..)
  , Protocol(..)
  , OptionName(..)
  , OptionValue(..)
  , Level(..)
  , Message(..)
  , MessageFlags(..)
  , ShutdownType(..)
  , AddressInfo
    -- * Socket Address
    -- ** Types
  , SocketAddress(..)
  , PST.SocketAddressInternet(..)
  , PST.SocketAddressUnix(..)
    -- ** Encoding
  , PSP.encodeSocketAddressInternet
  , PSP.encodeSocketAddressUnix
    -- ** Decoding
  , PSP.decodeSocketAddressInternet
  , PSP.indexSocketAddressInternet
    -- ** Sizes
  , PSP.sizeofSocketAddressInternet
    -- * Data Construction
    -- ** Socket Domains
  , pattern PST.Unix
  , pattern PST.Unspecified
  , pattern PST.Internet
  , pattern PST.Internet6
    -- ** Socket Types
  , PST.stream
  , PST.datagram
  , PST.raw
  , PST.sequencedPacket
    -- ** Protocols
  , PST.defaultProtocol
  , PST.rawProtocol
  , PST.icmp
  , PST.tcp
  , PST.udp
  , PST.ip
  , PST.ipv6
    -- ** Receive Flags
  , PST.peek
  , PST.outOfBand
  , PST.waitAll
    -- ** Send Flags
  , PST.noSignal
    -- ** Shutdown Types
  , PST.read
  , PST.write
  , PST.readWrite
    -- ** Socket Levels
  , PST.levelSocket
    -- ** Option Names
  , PST.optionError
  , PST.bindToDevice
  , PST.broadcast
  , PST.reuseAddress
    -- ** Address Info
    -- *** Peek
  , PST.peekAddressInfoFlags
    -- *** Poke
  , PST.pokeAddressInfoFlags
    -- *** Metadata
  , PST.sizeofAddressInfo
    -- ** Message Header
    -- *** Peek
  , PST.peekMessageHeaderName
  , PST.peekMessageHeaderNameLength
  , PST.peekMessageHeaderIOVector
  , PST.peekMessageHeaderIOVectorLength
  , PST.peekMessageHeaderControl
  , PST.peekMessageHeaderControlLength
  , PST.peekMessageHeaderFlags
  , PST.peekControlMessageHeaderLevel
  , PST.peekControlMessageHeaderLength
  , PST.peekControlMessageHeaderType
    -- *** Poke
  , PST.pokeMessageHeaderName
  , PST.pokeMessageHeaderNameLength
  , PST.pokeMessageHeaderIOVector
  , PST.pokeMessageHeaderIOVectorLength
  , PST.pokeMessageHeaderControl
  , PST.pokeMessageHeaderControlLength
  , PST.pokeMessageHeaderFlags
    -- *** Metadata
  , PST.sizeofMessageHeader
    -- ** IO Vector
    -- *** Peek
  , PST.peekIOVectorBase
  , PST.peekIOVectorLength
    -- *** Poke
  , PST.pokeIOVectorBase
  , PST.pokeIOVectorLength
    -- *** Metadata
  , 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

-- This module include operating-system specific code used
-- to serialize some of various kind of socket address types.
import qualified Posix.Socket.Platform as PSP

-- getaddrinfo cannot use the unsafe ffi
foreign import ccall safe "sys/socket.h getaddrinfo"
  c_safe_getaddrinfo ::
       CString
    -> CString
    -> Ptr AddressInfo
    -> MutableByteArray# RealWorld -- actually a `Ptr (Ptr AddressInfo))`.
    -> IO Errno

-- | Free the @addrinfo@ at the pointer.
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

-- Per the spec, the type signature of bind is:
--   int bind(int socket, const struct sockaddr *address, socklen_t address_len);
-- However, here we choose to represent the third argument as
-- CInt rather than introducing a type corresponding to socklen_t.
-- According to Linus Torvalds, "Any sane library must have socklen_t
-- be the same size as int. Anything else breaks any BSD socket layer stuff."
-- (https://yarchive.net/comp/linux/socklen_t.html). If a platform
-- violates this assumption, this wrapper will be broken on that platform.
foreign import ccall unsafe "sys/socket.h bind"
  c_bind :: Fd -> ByteArray# -> CInt -> IO CInt

-- Per the spec, the type signature of accept is:
--   int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);
-- The restrict keyword does not matter much for our purposes. See the
-- note on c_bind for why we use CInt for socklen_t. Remember that the
-- first bytearray argument is actually SocketAddress in the function that
-- wraps this one. The second bytearray argument is a pointer to the size.
foreign import ccall safe "sys/socket.h accept"
  c_safe_accept :: Fd
                -> MutableByteArray# RealWorld -- SocketAddress
                -> MutableByteArray# RealWorld -- Ptr CInt
                -> IO Fd
foreign import ccall unsafe "sys/socket.h accept"
  c_unsafe_accept :: Fd
                  -> MutableByteArray# RealWorld -- SocketAddress
                  -> MutableByteArray# RealWorld -- Ptr CInt
                  -> IO Fd
-- This variant of accept is used when we do not care about the
-- remote sockaddr. We pass null.
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 -- SocketAddress
                       -> MutableByteArray# RealWorld -- Addr length (Ptr CInt)
                       -> IO CInt

foreign import ccall unsafe "sys/socket.h getsockopt"
  c_unsafe_getsockopt :: Fd
                      -> Level
                      -> OptionName
                      -> MutableByteArray# RealWorld -- Option value
                      -> MutableByteArray# RealWorld -- Option len (Ptr CInt)
                      -> IO CInt

foreign import ccall unsafe "sys/socket.h setsockopt_int"
  c_unsafe_setsockopt_int :: Fd
                          -> Level
                          -> OptionName
                          -> CInt -- option_value
                          -> IO CInt

foreign import ccall unsafe "sys/socket.h setsockopt"
  c_unsafe_setsockopt :: Fd
                      -> Level
                      -> OptionName
                      -> Ptr Void -- option_val
                      -> CInt -- option_len
                      -> IO CInt

foreign import ccall unsafe "sys/socket.h setsockopt"
  c_unsafe_setsockopt_ba :: Fd
                         -> Level
                         -> OptionName
                         -> ByteArray# -- option_val
                         -> CInt -- option_len
                         -> IO CInt

-- Per the spec the type signature of connect is:
--   int connect(int sockfd, const struct sockaddr *addr, socklen_t addrlen);
-- The bytearray argument is actually SocketAddress.
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

-- There are several options for wrapping send. Both safe and unsafe
-- are useful. Additionally, in the unsafe category, we also
-- have the option of writing to either an address or a byte array.
-- Unsafe FFI calls guarantee that byte arrays will not be relocated
-- while the FFI call is taking place. Safe FFI calls do not have
-- this guarantee, so internally we must be careful when using these to only
-- provide pinned byte arrays as arguments.
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

-- The ByteArray# (second to last argument) is a SocketAddress.
foreign import ccall unsafe "sys/socket.h sendto_offset"
  c_unsafe_bytearray_sendto :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize
-- The ByteArray# (second to last argument) is a SocketAddress.
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

-- There are several ways to wrap recv.
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

-- The last two arguments are SocketAddress and Ptr CInt.
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# -- This addr is a pointer to msghdr
                        -> MessageFlags 'Receive
                        -> IO CSsize

-- | Create an endpoint for communication, returning a file
--   descriptor that refers to that endpoint. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/socket.html POSIX specification>
--   includes more details. No special preparation is required before calling
--   this function. The author believes that it cannot block for a prolonged
--   period of time.
uninterruptibleSocket ::
     Family -- ^ Communications domain (e.g. 'internet', 'unix')
  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags
  -> Protocol -- ^ 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

-- | Create an unbound pair of connected sockets in a specified domain, of
--   a specified type, under the protocol optionally specified by the protocol
--   argument. The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/socketpair.html POSIX specification>
--   includes more details. No special preparation is required before calling
--   this function. The author believes that it cannot block for a prolonged
--   period of time.
uninterruptibleSocketPair ::
     Family -- ^ Communications domain (probably 'unix')
  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags
  -> Protocol -- ^ Protocol
  -> IO (Either Errno (Fd,Fd))
uninterruptibleSocketPair :: Family -> Type -> Protocol -> IO (Either Errno (Fd, Fd))
uninterruptibleSocketPair Family
dom Type
typ Protocol
prot = do
  -- If this ever switches to the safe FFI, we will need to use
  -- a pinned array here instead.
  (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


-- | Given node and service, which identify an Internet host and a service,
-- @getaddrinfo()@ returns one or more @addrinfo@ structures. The type of this
-- wrapper differs slightly from the type of its C counterpart. Remember to call
-- 'uninterruptibleFreeAddressInfo' when finished with the result.
getAddressInfo ::
     CString -- ^ Node, identifies an Internet host
  -> CString -- ^ Service
  -> Ptr AddressInfo -- ^ Hints
  -> 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)

-- | Assign a local socket address address to a socket identified by
--   descriptor socket that has no local socket address assigned. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/bind.html POSIX specification>
--   includes more details. The 'SocketAddress' represents the @sockaddr@ pointer argument, together
--   with its @socklen_t@ size, as a byte array. This allows @bind@ to
--   be used with @sockaddr@ extensions on various platforms. No special
--   preparation is required before calling this function. The author
--   believes that it cannot block for a prolonged period of time.
uninterruptibleBind ::
     Fd -- ^ Socket
  -> SocketAddress -- ^ Socket address, extensible tagged union
  -> 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_

-- | Mark the socket as a passive socket, that is, as a socket that
--   will be used to accept incoming connection requests using @accept@.
--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/listen.html POSIX specification>
--   includes more details. No special preparation is required before
--   calling this function. The author believes that it cannot block
--   for a prolonged period of time.
uninterruptibleListen ::
     Fd -- ^ Socket
  -> CInt -- ^ Backlog
  -> 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 the socket to the specified socket address.
--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html POSIX specification>
--   includes more details.
connect ::
     Fd -- ^ Fd
  -> SocketAddress -- ^ Socket address, extensible tagged union
  -> 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_

-- | Connect the socket to the specified socket address.
--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html POSIX specification>
--   includes more details. The only sensible way to use this is to
--   give a nonblocking socket as the argument.
uninterruptibleConnect ::
     Fd -- ^ Fd
  -> SocketAddress -- ^ Socket address, extensible tagged union
  -> 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 -- ^ Fd
  -> Ptr a -- ^ Socket address
  -> Int -- ^ Size of socket address
  -> 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_

-- | Extract the first connection on the queue of pending connections. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>
--   includes more details. This function\'s type differs slightly from
--   the specification:
--
--   > int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);
--
--   Instead of requiring the caller to prepare buffers through which
--   information is returned, this haskell binding to @accept@ prepares
--   those buffers internally. This eschews C\'s characteristic buffer-passing
--   in favor of the Haskell convention of allocating internally and returning.
--
--   More specifically, this binding lacks an argument corresponding to the
--   @sockaddr@ buffer from the specification. That mutable buffer is allocated
--   internally, resized and frozen upon a success, and returned along with
--   the file descriptor of the accepted socket. The size of this buffer is
--   determined by the second argument (maximum socket address size). This
--   size argument is also writen to the @address_len@ buffer, which is also
--   allocated internally. The size returned through this pointer is used to
--   resize the @sockaddr@ buffer, which is then frozen so that an immutable
--   'SocketAddress' is returned to the end user.
--
--   For applications uninterested in the peer (described by @sockaddr@),
--   POSIX @accept@ allows the null pointer to be passed as both @address@ and
--   @address_len@. This behavior is provided by 'accept_'.
accept ::
     Fd -- ^ Listening socket
  -> CInt -- ^ Maximum socket address size
  -> IO (Either Errno (CInt,SocketAddress,Fd)) -- ^ Peer information and connected socket
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
      -- Why copy when we could just shrink? We want to always return
      -- byte arrays that are not explicitly pinned.
      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

-- | See 'accept'. This uses the unsafe FFI. Consequently, it does not
--   not need to allocate pinned memory. It only makes sense to call this
--   on a nonblocking socket.
uninterruptibleAccept ::
     Fd -- ^ Listening socket
  -> CInt -- ^ Maximum socket address size
  -> IO (Either Errno (CInt,SocketAddress,Fd)) -- ^ Peer information and connected socket
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

-- | A variant of 'accept' that does not provide the user with a
--   'SocketAddress' detailing the peer.
accept_ ::
     Fd -- ^ Listening socket
  -> IO (Either Errno Fd) -- ^ Connected socket
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

-- | Retrieve the locally-bound name of the specified socket. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>
--   of @getsockname@ includes more details.
uninterruptibleGetSocketName ::
     Fd -- ^ Socket
  -> CInt -- ^ Maximum socket address size
  -> 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

-- | Retrieve the value for the option specified by the 'Option' argument for
--   the socket specified by the 'Fd' argument. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>
--   of @getsockopt@ includes more details.
uninterruptibleGetSocketOption ::
     Fd -- ^ Socket
  -> Level -- ^ Socket level
  -> OptionName -- Option name
  -> CInt -- ^ Maximum option value size
  -> 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

-- | Set the value for the option specified by the 'Option' argument for
--   the socket specified by the 'Fd' argument. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>
--   of @getsockopt@ includes more details. This variant requires that the
--   size of the @option_value@
--   be the same as the size of 'CInt'. That is, the @option_name@ must
--   describe an option that is represented by a C integer. This is a
--   common case, so we avoid allocations by reference-passing in C.
uninterruptibleSetSocketOptionInt ::
     Fd -- ^ Socket
  -> Level -- ^ Socket level
  -> OptionName -- ^ Option name
  -> CInt -- ^ Option value
  -> 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_

-- | Set the value for the option specified by the 'Option' argument for
--   the socket specified by the 'Fd' argument. The
--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>
--   of @getsockopt@ includes more details.
uninterruptibleSetSocketOption ::
     Fd -- ^ Socket
  -> Level -- ^ Socket level
  -> OptionName -- ^ Option name
  -> Ptr Void -- ^ Option value
  -> CInt -- ^ Option value length
  -> 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_

-- | Variant of 'uninterruptibleSetSocketOption' that accepts the option
--   as a byte array instead of a pointer into unmanaged memory. The argument
--   does not need to be pinned.
uninterruptibleSetSocketOptionByteArray ::
     Fd -- ^ Socket
  -> Level -- ^ Socket level
  -> OptionName -- ^ Option name
  -> ByteArray -- ^ Option value
  -> CInt -- ^ Option value length
  -> 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_

-- | Send data from a byte array over a network socket. Users
--   may specify an offset and a length to send fewer bytes than are
--   actually present in the array. Since this uses the safe
--   FFI, it allocates a pinned copy of the bytearry if it was not
--   already pinned.
sendByteArray ::
     Fd -- ^ Socket
  -> ByteArray -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- Internal function. Fold with strict accumulator. Upper bound is exclusive.
-- Hits every int in the range [0,hi) from highest to lowest.
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

-- | Copy and pin a byte array if, it's not already pinned.
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

-- | Send two payloads (one from unmanaged memory and one from
-- managed memory) over a network socket.
uninterruptibleSendMessageA ::
     Fd -- ^ Socket
  -> Addr -- ^ Source address (payload A)
  -> CSize -- ^ Length in bytes (payload A)
  -> MutableByteArrayOffset RealWorld -- ^ Source and offset (payload B)
  -> CSize -- ^ Length in bytes (payload B)
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send two payloads (one from managed memory and one from
-- unmanaged memory) over a network socket.
uninterruptibleSendMessageB ::
     Fd -- ^ Socket
  -> MutableByteArrayOffset RealWorld -- ^ Source and offset (payload B)
  -> CSize -- ^ Length in bytes (payload B)
  -> Addr -- ^ Source address (payload A)
  -> CSize -- ^ Length in bytes (payload A)
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from a mutable byte array over a network socket. Users
--   may specify an offset and a length to send fewer bytes than are
--   actually present in the array. Since this uses the safe
--   FFI, it allocates a pinned copy of the bytearry if it was not
--   already pinned.
sendMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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 data from an address over a network socket. This is not guaranteed
--   to send the entire length. This uses the safe FFI since
--   it may block indefinitely.
send ::
     Fd -- ^ Connected socket
  -> Addr -- ^ Source address
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from an address over a network socket. This uses the unsafe FFI.
--   Users of this function should be sure to set flags that prohibit this
--   from blocking. On Linux this is accomplished with @O_NONBLOCK@. It is
--   often desirable to call 'threadWaitWrite' on a nonblocking socket before
--   calling @unsafeSend@ on it.
uninterruptibleSend ::
     Fd -- ^ Socket
  -> Addr -- ^ Source address
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from a byte array over a network socket. This uses the unsafe FFI;
--   considerations pertaining to 'sendUnsafe' apply to this function as well. Users
--   may specify a length to send fewer bytes than are actually present in the
--   array.
uninterruptibleSendByteArray ::
     Fd -- ^ Socket
  -> ByteArray -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from a mutable byte array over a network socket. This uses the unsafe FFI;
--   considerations pertaining to 'sendUnsafe' apply to this function as well. Users
--   specify an offset and a length to send fewer bytes than are actually present in the
--   array.
uninterruptibleSendMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Source mutable byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from a byte array over an unconnected network socket.
--   This uses the unsafe FFI; considerations pertaining to 'sendToUnsafe'
--   apply to this function as well. The offset and length arguments
--   cause a slice of the byte array to be sent rather than the entire
--   byte array.
uninterruptibleSendToByteArray ::
     Fd -- ^ Socket
  -> ByteArray -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> SocketAddress -- ^ Socket Address
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Variant of 'uninterruptibleSendToByteArray' that requires
--   that @sockaddr_in@ be used as the socket address. This is used to
--   avoid allocating a buffer for the socket address when the caller
--   knows in advance that they are sending to an IPv4 address.
uninterruptibleSendToInternetByteArray ::
     Fd -- ^ Socket
  -> ByteArray -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> SocketAddressInternet -- ^ Socket Address
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Variant of 'uninterruptibleSendToByteArray' that requires
--   that @sockaddr_in@ be used as the socket address. This is used to
--   avoid allocating a buffer for the socket address when the caller
--   knows in advance that they are sending to an IPv4 address.
uninterruptibleSendToInternet ::
     Fd -- ^ Socket
  -> Addr -- ^ Source byte array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> SocketAddressInternet -- ^ Socket Address
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Send data from a mutable byte array over an unconnected network socket.
--   This uses the unsafe FFI; concerns pertaining to 'uninterruptibleSend'
--   apply to this function as well. The offset and length arguments
--   cause a slice of the mutable byte array to be sent rather than the entire
--   byte array.
uninterruptibleSendToMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> SocketAddress -- ^ Socket Address
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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

-- | Variant of 'uninterruptibleSendToMutableByteArray' that requires
--   that @sockaddr_in@ be used as the socket address. This is used to
--   avoid allocating a buffer for the socket address when the caller
--   knows in advance that they are sending to an IPv4 address.
uninterruptibleSendToInternetMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Source byte array
  -> Int -- ^ Offset into source array
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Send -- ^ Flags
  -> SocketAddressInternet -- ^ Socket Address
  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer
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 data into an address from a network socket. This wraps @recv@ using
--   the safe FFI. When the returned size is zero, there are no
--   additional bytes to receive and the peer has performed an orderly shutdown.
receive ::
     Fd -- ^ Socket
  -> Addr -- ^ Source address
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Receive -- ^ Flags
  -> 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

-- | Receive data into a byte array from a network socket. This wraps @recv@ using
--   the safe FFI. When the returned size is zero, there are no
--   additional bytes to receive and the peer has performed an orderly shutdown.
receiveByteArray ::
     Fd -- ^ Socket
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Receive -- ^ Flags
  -> 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
      -- Why copy when we could just shrink? We want to always return
      -- byte arrays that are not explicitly pinned.
      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

-- | Receive data into an address from a network socket. This wraps @recv@
--   using the unsafe FFI. Users of this function should be sure to set flags
--   that prohibit this from blocking. On Linux this is accomplished by setting
--   the @MSG_DONTWAIT@ flag and handling the resulting @EAGAIN@ or
--   @EWOULDBLOCK@. When the returned size is zero, there are no additional
--   bytes to receive and the peer has performed an orderly shutdown.
uninterruptibleReceive ::
     Fd -- ^ Socket
  -> Addr -- ^ Source address
  -> CSize -- ^ Length in bytes
  -> MessageFlags 'Receive -- ^ Flags
  -> 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

-- | Receive data into an address from a network socket. This uses the unsafe
--   FFI; considerations pertaining to 'receiveUnsafe' apply to this function
--   as well. Users may specify a length to receive fewer bytes than are
--   actually present in the mutable byte array.
uninterruptibleReceiveMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Destination byte array
  -> Int -- ^ Destination offset
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Bytes received into array
{-# 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

-- | Receive data into an address from an unconnected network socket. This
--   uses the unsafe FFI. Users may specify an offset into the destination
--   byte array. This function does not resize the buffer.
uninterruptibleReceiveFromMutableByteArray ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Destination byte array
  -> Int -- ^ Destination offset
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> CInt -- ^ Maximum socket address size
  -> IO (Either Errno (CInt,SocketAddress,CSize))
     -- ^ Remote host, bytes received into array, bytes needed for @addrlen@.
{-# inline uninterruptibleReceiveFromMutableByteArray #-}
-- GHC does not inline this unless we give it the pragma. We really
-- want this to inline since inlining typically avoids the Left/Right
-- data constructor allocation.
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
  -- TODO: We currently allocate one buffer for the size and
  -- one for the peer. We could improve this by allocating
  -- a single buffer instead. We would need to add some
  -- cleverness in the cbits directory.
  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 -- ^ Socket
  -> Addr -- ^ Destination byte array
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> MutablePrimArrayOffset RealWorld SocketAddressInternet -- ^ Address
  -> IO (Either Errno CSize) -- ^ Number of bytes received into array
{-# 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 -- ^ Socket
  -> MutableByteArrayOffset RealWorld -- ^ Destination byte array
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> MutablePrimArrayOffset RealWorld SocketAddressInternet -- ^ Address
  -> IO (Either Errno CSize) -- ^ Number of bytes received into array
{-# 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

-- | Receive data into an address from a network socket. This uses the unsafe
--   FFI. This does not return the socket address of the remote host that
--   sent the packet received.
uninterruptibleReceiveFromMutableByteArray_ ::
     Fd -- ^ Socket
  -> MutableByteArray RealWorld -- ^ Destination byte array
  -> Int -- ^ Destination offset
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes received into array
{-# 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

-- | Receive data into an address from a network socket. This uses the unsafe
--   FFI. This does not return the socket address of the remote host that
--   sent the packet received.
uninterruptibleReceiveFrom_ ::
     Fd -- ^ Socket
  -> Addr -- ^ Destination byte array
  -> CSize -- ^ Maximum bytes to receive
  -> MessageFlags 'Receive -- ^ Flags
  -> IO (Either Errno CSize) -- ^ Number of bytes received into array
{-# 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

-- | Shutdown a socket. This uses the unsafe FFI.
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

-- Sometimes, functions that return an int use zero to indicate
-- success and negative one to indicate failure without including
-- additional information in the value.
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

-- only call this when it is known that the argument is non-negative
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)

-- | Convert a 16-bit word from host to network byte order (e.g. @htons@).
hostToNetworkShort :: Word16 -> Word16
hostToNetworkShort :: Word16 -> Word16
hostToNetworkShort = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian -> forall a. a -> a
id
  ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16

-- | Convert a 16-bit word from network to host byte order (e.g. @ntohs@).
networkToHostShort :: Word16 -> Word16
networkToHostShort :: Word16 -> Word16
networkToHostShort = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian -> forall a. a -> a
id
  ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16

-- | Convert a 32-bit word from host to network byte order (e.g. @htonl@).
hostToNetworkLong :: Word32 -> Word32
hostToNetworkLong :: Word32 -> Word32
hostToNetworkLong = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian -> forall a. a -> a
id
  ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32

-- | Convert a 32-bit word from network to host byte order (e.g. @ntohl@).
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 ()
pokeMessageHeader :: Addr
-> Addr
-> CInt
-> Addr
-> CSize
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO ()
pokeMessageHeader 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)
-- | Write data from multiple byte arrays to the file/socket associated
--   with the file descriptor. This does not support slicing. The
--   <http://pubs.opengroup.org/onlinepubs/009604499/functions/writev.html POSIX specification>
--   of @writev@ includes more details.
writeVector ::
     Fd -- ^ Socket
  -> UnliftedArray ByteArray -- ^ Source byte arrays
  -> IO (Either Errno CSize)
writeVector fd buffers = do
  iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <-
    PM.newPinnedByteArray
      (cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)
  -- We construct a list of the new buffers for the sole purpose
  -- of ensuring that we can touch the list later to keep all
  -- the new buffers live.
  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))
  -- Touching both the unlifted array and the list of new buffers
  -- here is crucial to ensuring that
  -- the buffers do not get GCed before c_safe_writev. Just touching
  -- them should keep all of their children alive too.
  touchUnliftedArray buffers
  touchLifted newBufs
  pure r

-- | Send many immutable byte arrays with @sendmsg@.
-- This accepts a slice into the chunks. Additionally,
-- this accepts an offset into the first chunk.
uninterruptibleSendByteArrays ::
     Fd -- ^ Socket
  -> UnliftedArray ByteArray -- ^ Byte arrays
  -> Int -- ^ Offset into byte array chunks
  -> Int -- ^ Number of chunks to send
  -> Int -- ^ Offset into first chunk
  -> 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

-- | Receive a message, scattering the input. This does not provide
--   the socket address or the control messages. All of the chunks
--   must have the same maximum size. All resulting byte arrays have
--   been explicitly pinned.
uninterruptibleReceiveMessageA ::
     Fd -- ^ Socket
  -> CSize -- ^ Maximum bytes per chunk
  -> CSize -- ^ Maximum number of chunks
  -> MessageFlags 'Receive -- ^ Flags
  -> 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

-- | Receive a message, scattering the input. This provides the socket
--   address but does not include control messages. All of the chunks
--   must have the same maximum size. All resulting byte arrays have
--   been explicitly pinned.
uninterruptibleReceiveMessageB ::
     Fd -- ^ Socket
  -> CSize -- ^ Maximum bytes per chunk
  -> CSize -- ^ Maximum number of chunks
  -> MessageFlags 'Receive -- ^ Flags
  -> CInt -- ^ Maximum socket address size
  -> 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

-- This sets up an array of iovec. The iov_len is assigned to the
-- same length in all of these. The actual buffers are allocated
-- and stuck in an unlifted array. Pointers to these buffers (we can
-- do that because they are pinned) go in the iov_base field.
initializeIOVectors ::
     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers
  -> Addr -- array of iovec
  -> CSize -- chunk size
  -> CSize -- chunk count
  -> 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

-- Initialize a single iovec. We write the pinned byte array into
-- both the iov_base field and into an unlifted array. There is a
-- copy of this function in Linux.Socket.
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

-- This is intended to be called on an array of iovec after recvmsg
-- and before deepFreezeIOVectors. An adaptation of this function exists
-- in Linux.Socket.
countAndShrinkIOVectors ::
     Int -- Total number of supplied iovecs
  -> Int -- Total amount of space used by receive
  -> Int -- Amount of space per buffer (each buffer must have equal size)
  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)
  -> IO Int
countAndShrinkIOVectors !n !totalUsedSz !maxBufSz !bufs = go 0 totalUsedSz where
  -- This outer if (checking that the index is in bounds) should
  -- not actually be necessary. I will remove once the test suite
  -- bolsters my confidence.
  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

-- Freeze a slice of the mutable byte arrays inside the unlifted
-- array. This copies makes a copy of the slice of the original
-- array. A copy of this function exists in Linux.Socket.
deepFreezeIOVectors ::
     Int -- How many iovecs actually had a non-zero number of bytes
  -> 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', () #)

{- $conversion
These functions are used to convert IPv4 addresses and ports between network
byte order and host byte order. They are essential when working with
'SocketAddressInternet'. To avoid getting in the way of GHC compile-time
optimizations, these functions are not actually implemented with FFI
calls to @htonl@ and friends. Rather, they are reimplemented in haskell.
-}


{- $receiveMessage
The function @recvMsg@ presents us with a challenge. Since it uses a
data structure with many nested pointers, we have to use pinned byte
arrays for everything. There is also the difficulty of marshalling
haskell's unlifted array (array of arrays) type into what C's
array of @iovec@. There's the question of the array of @cmsghdr@s.
On top of all of this, we have to answer the question of whether
we want to accept mutable buffer or whether we want to do the
allocations internally (both for the buffers and for the ancilliary
data structurs needed to massage the data into what C expects).

What we do to handle this in offer several variants of @recvmsg@
ending in @A@, @B@, etc.
-}

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