{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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
  , withSocket

    -- ** 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

    -- ** Receive
  , receive
  , receiveByteArray
  , uninterruptibleReceive
  , uninterruptibleReceiveMutableByteArray

    -- ** Receive From
  , uninterruptibleReceiveFromMutableByteArray
  , uninterruptibleReceiveFromMutableByteArray_
  , uninterruptibleReceiveFrom_
  , uninterruptibleReceiveFromInternet
  , uninterruptibleReceiveFromInternetMutableByteArray

    -- ** Receive Message
    -- $receiveMessage
  , uninterruptibleSendMessageA
  , uninterruptibleSendMessageB

    -- ** 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 Control.Exception (mask, onException)
import Data.Primitive (ByteArray (..), MutableByteArray (..), MutablePrimArray (..))
import Data.Primitive.Addr (Addr (..))
import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset (..))
import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset (..))
import Data.Void (Void)
import Data.Word (Word16, Word32, Word8, byteSwap16, byteSwap32)
import Foreign.C.Error (Errno (Errno), getErrno)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt (..), CSize (..))
import Foreign.Ptr (nullPtr)
import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian), targetByteOrder)
import GHC.Exts (Addr#, ByteArray#, Int (I#), MutableByteArray#, Ptr (Ptr), RealWorld, shrinkMutableByteArray#)
import Posix.Socket.Types
  ( AddressInfo
  , Family (..)
  , Level (..)
  , Message (..)
  , MessageFlags (..)
  , OptionName (..)
  , OptionValue (..)
  , Protocol (..)
  , ShutdownType (..)
  , SocketAddress (..)
  , SocketAddressInternet (..)
  , Type (..)
  )
import System.Posix.Types (CSsize (..), Fd (..))

import qualified Control.Monad.Primitive as PM
import qualified Data.Primitive as PM
import qualified GHC.Exts as Exts
import qualified Posix.File as F
import qualified Posix.Socket.Types as PST

-- 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

-- 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

{- | 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 ::
  -- | Communications domain (e.g. 'internet', 'unix')
  Family ->
  -- | Socket type (e.g. 'datagram', 'stream') with flags
  Type ->
  -- | 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 IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd

-- | Alias for 'uninterruptibleSocket'.
socket ::
  -- | Communications domain (e.g. 'internet', 'unix')
  Family ->
  -- | Socket type (e.g. 'datagram', 'stream') with flags
  Type ->
  -- | Protocol
  Protocol ->
  IO (Either Errno Fd)
socket :: Family -> Type -> Protocol -> IO (Either Errno Fd)
socket = Family -> Type -> Protocol -> IO (Either Errno Fd)
uninterruptibleSocket

{- | Helper function for the common case where 'socket' or
'uninterruptibleSocket' is paired with 'close'. This ensures that the
socket is closed even in the case of an exception. Do not call 'close' in
the callback since 'close' is called by this function after the callback
completes (or after an exception is thrown).

This is implementated with @mask@ (and restore) and @onException@
directly rather than with @bracket@.
-}
withSocket ::
  -- | Communications domain (e.g. 'internet', 'unix')
  Family ->
  -- | Socket type (e.g. 'datagram', 'stream') with flags
  Type ->
  -- | Protocol
  Protocol ->
  -- | Callback that uses the socket. Must not close the socket.
  -- The callback is not used when the @socket()@ call fails.
  (Fd -> IO a) ->
  IO (Either Errno a)
{-# INLINE withSocket #-}
withSocket :: forall a.
Family -> Type -> Protocol -> (Fd -> IO a) -> IO (Either Errno a)
withSocket !Family
dom !Type
typ !Protocol
prot Fd -> IO a
cb =
  ((forall a. IO a -> IO a) -> IO (Either Errno a))
-> IO (Either Errno a)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Either Errno a))
 -> IO (Either Errno a))
-> ((forall a. IO a -> IO a) -> IO (Either Errno a))
-> IO (Either Errno a)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Fd
r <- Family -> Type -> Protocol -> IO Fd
c_socket Family
dom Type
typ Protocol
prot
    if Fd
r Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
      then do
        a
a <- IO a -> IO a
forall a. IO a -> IO a
restore (Fd -> IO a
cb Fd
r) IO a -> IO (Either Errno ()) -> IO a
forall a b. IO a -> IO b -> IO a
`onException` Fd -> IO (Either Errno ())
F.close Fd
r
        Either Errno ()
_ <- Fd -> IO (Either Errno ())
F.close Fd
r
        Either Errno a -> IO (Either Errno a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either Errno a
forall a b. b -> Either a b
Right a
a)
      else (Errno -> Either Errno a) -> IO Errno -> IO (Either Errno a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno a
forall a b. a -> Either a b
Left IO Errno
getErrno

{- | 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 ::
  -- | Communications domain (probably 'unix')
  Family ->
  -- | Socket type (e.g. 'datagram', 'stream') with flags
  Type ->
  -- | 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) <- Int -> IO (MutablePrimArray (PrimState IO) 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 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
    then do
      Fd
fd1 <- MutablePrimArray (PrimState IO) Fd -> Int -> IO Fd
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray RealWorld Fd
MutablePrimArray (PrimState IO) Fd
sockets Int
0
      Fd
fd2 <- MutablePrimArray (PrimState IO) Fd -> Int -> IO Fd
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray RealWorld Fd
MutablePrimArray (PrimState IO) Fd
sockets Int
1
      Either Errno (Fd, Fd) -> IO (Either Errno (Fd, Fd))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Fd, Fd) -> Either Errno (Fd, Fd)
forall a b. b -> Either a b
Right (Fd
fd1, Fd
fd2))
    else (Errno -> Either Errno (Fd, Fd))
-> IO Errno -> IO (Either Errno (Fd, Fd))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (Fd, Fd)
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 ::
  -- | Node, identifies an Internet host
  CString ->
  -- | Service
  CString ->
  -- | Hints
  Ptr AddressInfo ->
  IO (Either Errno (Ptr AddressInfo))
getAddressInfo :: CString
-> CString
-> Ptr AddressInfo
-> IO (Either Errno (Ptr AddressInfo))
getAddressInfo !CString
node !CString
service !Ptr AddressInfo
hints = do
  resBuf :: MutableByteArray RealWorld
resBuf@(MutableByteArray MutableByteArray# RealWorld
resBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (Ptr () -> Int
forall a. Prim a => a -> Int
PM.sizeOf (Ptr ()
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# IO Errno
-> (Errno -> IO (Either Errno (Ptr AddressInfo)))
-> IO (Either Errno (Ptr AddressInfo))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Errno CInt
0 -> do
      Ptr AddressInfo
res <- MutableByteArray (PrimState IO) -> Int -> IO (Ptr AddressInfo)
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
resBuf Int
0
      Either Errno (Ptr AddressInfo)
-> IO (Either Errno (Ptr AddressInfo))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr AddressInfo -> Either Errno (Ptr AddressInfo)
forall a b. b -> Either a b
Right Ptr AddressInfo
res)
    Errno
e -> Either Errno (Ptr AddressInfo)
-> IO (Either Errno (Ptr AddressInfo))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno (Ptr AddressInfo)
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 ::
  -- | Socket
  Fd ->
  -- | Socket address, extensible tagged union
  SocketAddress ->
  IO (Either Errno ())
uninterruptibleBind :: Fd -> SocketAddress -> IO (Either Errno ())
uninterruptibleBind Fd
fd (SocketAddress b :: ByteArray
b@(ByteArray ByteArray#
b#)) =
  Fd -> ByteArray# -> CInt -> IO CInt
c_bind Fd
fd ByteArray#
b# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
b)) IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO 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 ::
  -- | Socket
  Fd ->
  -- | Backlog
  CInt ->
  IO (Either Errno ())
uninterruptibleListen :: Fd -> CInt -> IO (Either Errno ())
uninterruptibleListen Fd
fd CInt
backlog = Fd -> CInt -> IO CInt
c_listen Fd
fd CInt
backlog IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ->
  -- | Socket address, extensible tagged union
  SocketAddress ->
  IO (Either Errno ())
connect :: Fd -> SocketAddress -> IO (Either Errno ())
connect Fd
fd (SocketAddress sockAddr :: ByteArray
sockAddr@(ByteArray ByteArray#
sockAddr#)) =
  case ByteArray -> Bool
isByteArrayPinned ByteArray
sockAddr of
    Bool
True -> Fd -> ByteArray# -> CInt -> IO CInt
c_safe_connect Fd
fd ByteArray#
sockAddr# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
sockAddr)) IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
len
      MutableByteArray (PrimState IO)
-> Int -> ByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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) IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ->
  -- | Socket address, extensible tagged union
  SocketAddress ->
  IO (Either Errno ())
uninterruptibleConnect :: Fd -> SocketAddress -> IO (Either Errno ())
uninterruptibleConnect Fd
fd (SocketAddress sockAddr :: ByteArray
sockAddr@(ByteArray ByteArray#
sockAddr#)) =
  Fd -> ByteArray# -> CInt -> IO CInt
c_unsafe_connect Fd
fd ByteArray#
sockAddr# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
sockAddr)) IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_

uninterruptibleConnectPtr ::
  -- | Fd
  Fd ->
  -- | Socket address
  Ptr a ->
  -- | Size of socket address
  Int ->
  IO (Either Errno ())
uninterruptibleConnectPtr :: forall a. Fd -> Ptr a -> Int -> IO (Either Errno ())
uninterruptibleConnectPtr !Fd
fd (Ptr Addr#
sockAddr#) !Int
sz =
  Fd -> Addr# -> CInt -> IO CInt
c_unsafe_connect_addr Fd
fd Addr#
sockAddr# (Int -> CInt
intToCInt Int
sz) IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Listening socket
  Fd ->
  -- | Maximum socket address size
  CInt ->
  -- | Peer information and connected socket
  IO (Either Errno (CInt, SocketAddress, Fd))
accept :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress, Fd))
accept !Fd
sock !CInt
maxSz = do
  sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CInt -> Int
cintToInt CInt
maxSz)
  lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CInt -> Int
forall a. Prim a => a -> Int
PM.sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
  MutableByteArray (PrimState IO) -> Int -> CInt -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
    then do
      (CInt
sz :: CInt) <- MutableByteArray (PrimState IO) -> Int -> IO CInt
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 = CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
min CInt
sz CInt
maxSz
      MutableByteArray RealWorld
x <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
minSz)
      MutableByteArray (PrimState IO)
-> Int -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x Int
0 MutableByteArray RealWorld
MutableByteArray (PrimState IO)
sockAddrBuf Int
0 (CInt -> Int
cintToInt CInt
minSz)
      ByteArray
sockAddr <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x
      Either Errno (CInt, SocketAddress, Fd)
-> IO (Either Errno (CInt, SocketAddress, Fd))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt, SocketAddress, Fd) -> Either Errno (CInt, SocketAddress, Fd)
forall a b. b -> Either a b
Right (CInt
sz, ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr, Fd
r))
    else (Errno -> Either Errno (CInt, SocketAddress, Fd))
-> IO Errno -> IO (Either Errno (CInt, SocketAddress, Fd))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (CInt, SocketAddress, Fd)
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 ::
  -- | Listening socket
  Fd ->
  -- | Maximum socket address size
  CInt ->
  -- | Peer information and connected socket
  IO (Either Errno (CInt, SocketAddress, Fd))
uninterruptibleAccept :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress, Fd))
uninterruptibleAccept !Fd
sock !CInt
maxSz = do
  sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
  lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
forall a. Prim a => a -> Int
PM.sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
  MutableByteArray (PrimState IO) -> Int -> CInt -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
    then do
      (CInt
sz :: CInt) <- MutableByteArray (PrimState IO) -> Int -> IO CInt
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
lenBuf Int
0
      if CInt
sz CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
maxSz
        then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
        else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ByteArray
sockAddr <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
sockAddrBuf
      Either Errno (CInt, SocketAddress, Fd)
-> IO (Either Errno (CInt, SocketAddress, Fd))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt, SocketAddress, Fd) -> Either Errno (CInt, SocketAddress, Fd)
forall a b. b -> Either a b
Right (CInt
sz, ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr, Fd
r))
    else (Errno -> Either Errno (CInt, SocketAddress, Fd))
-> IO Errno -> IO (Either Errno (CInt, SocketAddress, Fd))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (CInt, SocketAddress, Fd)
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_ ::
  -- | Listening socket
  Fd ->
  -- | Connected socket
  IO (Either Errno Fd)
accept_ :: Fd -> IO (Either Errno Fd)
accept_ Fd
sock =
  Fd -> Ptr Void -> Ptr CInt -> IO Fd
c_safe_ptr_accept Fd
sock Ptr Void
forall a. Ptr a
nullPtr Ptr CInt
forall a. Ptr a
nullPtr IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Maximum socket address size
  CInt ->
  IO (Either Errno (CInt, SocketAddress))
uninterruptibleGetSocketName :: Fd -> CInt -> IO (Either Errno (CInt, SocketAddress))
uninterruptibleGetSocketName Fd
sock CInt
maxSz = do
  sockAddrBuf :: MutableByteArray RealWorld
sockAddrBuf@(MutableByteArray MutableByteArray# RealWorld
sockAddrBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
  lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
forall a. Prim a => a -> Int
PM.sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
  MutableByteArray (PrimState IO) -> Int -> CInt -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
    then do
      (CInt
sz :: CInt) <- MutableByteArray (PrimState IO) -> Int -> IO CInt
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
lenBuf Int
0
      if CInt
sz CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
maxSz
        then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
        else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ByteArray
sockAddr <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
sockAddrBuf
      Either Errno (CInt, SocketAddress)
-> IO (Either Errno (CInt, SocketAddress))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt, SocketAddress) -> Either Errno (CInt, SocketAddress)
forall a b. b -> Either a b
Right (CInt
sz, ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr))
    else (Errno -> Either Errno (CInt, SocketAddress))
-> IO Errno -> IO (Either Errno (CInt, SocketAddress))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (CInt, SocketAddress)
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 ::
  -- | Socket
  Fd ->
  -- | Socket level
  Level ->
  OptionName -> -- Option name

  -- | Maximum option value size
  CInt ->
  IO (Either Errno (CInt, OptionValue))
uninterruptibleGetSocketOption :: Fd
-> Level
-> OptionName
-> CInt
-> IO (Either Errno (CInt, OptionValue))
uninterruptibleGetSocketOption Fd
sock Level
level OptionName
optName CInt
maxSz = do
  valueBuf :: MutableByteArray RealWorld
valueBuf@(MutableByteArray MutableByteArray# RealWorld
valueBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
  lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
forall a. Prim a => a -> Int
PM.sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
  MutableByteArray (PrimState IO) -> Int -> CInt -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
    then do
      (CInt
sz :: CInt) <- MutableByteArray (PrimState IO) -> Int -> IO CInt
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
lenBuf Int
0
      if CInt
sz CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
maxSz
        then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
valueBuf (CInt -> Int
cintToInt CInt
sz)
        else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ByteArray
value <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
valueBuf
      Either Errno (CInt, OptionValue)
-> IO (Either Errno (CInt, OptionValue))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt, OptionValue) -> Either Errno (CInt, OptionValue)
forall a b. b -> Either a b
Right (CInt
sz, ByteArray -> OptionValue
OptionValue ByteArray
value))
    else (Errno -> Either Errno (CInt, OptionValue))
-> IO Errno -> IO (Either Errno (CInt, OptionValue))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (CInt, OptionValue)
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 ::
  -- | Socket
  Fd ->
  -- | Socket level
  Level ->
  -- | Option name
  OptionName ->
  -- | Option value
  CInt ->
  IO (Either Errno ())
uninterruptibleSetSocketOptionInt :: Fd -> Level -> OptionName -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOptionInt Fd
sock Level
level OptionName
optName CInt
optValue =
  Fd -> Level -> OptionName -> CInt -> IO CInt
c_unsafe_setsockopt_int Fd
sock Level
level OptionName
optName CInt
optValue IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Socket level
  Level ->
  -- | Option name
  OptionName ->
  -- | Option value
  Ptr Void ->
  -- | Option value length
  CInt ->
  IO (Either Errno ())
uninterruptibleSetSocketOption :: Fd
-> Level -> OptionName -> Ptr Void -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOption Fd
sock Level
level OptionName
optName Ptr Void
optValue CInt
optLen =
  Fd -> Level -> OptionName -> Ptr Void -> CInt -> IO CInt
c_unsafe_setsockopt Fd
sock Level
level OptionName
optName Ptr Void
optValue CInt
optLen IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Socket level
  Level ->
  -- | Option name
  OptionName ->
  -- | Option value
  ByteArray ->
  -- | Option value length
  CInt ->
  IO (Either Errno ())
uninterruptibleSetSocketOptionByteArray :: Fd
-> Level -> OptionName -> ByteArray -> CInt -> IO (Either Errno ())
uninterruptibleSetSocketOptionByteArray Fd
sock Level
level OptionName
optName (ByteArray ByteArray#
optVal) CInt
optLen =
  Fd -> Level -> OptionName -> ByteArray# -> CInt -> IO CInt
c_unsafe_setsockopt_ba Fd
sock Level
level OptionName
optName ByteArray#
optVal CInt
optLen IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
sendByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendByteArray Fd
fd b :: ByteArray
b@(ByteArray ByteArray#
b#) Int
off CSize
len MessageFlags 'Send
flags =
  if ByteArray -> Bool
isByteArrayPinned ByteArray
b
    then CSsize -> IO (Either Errno CSize)
errorsFromSize (CSsize -> IO (Either Errno CSize))
-> IO CSsize -> IO (Either Errno CSize)
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#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
      MutableByteArray (PrimState IO)
-> Int -> ByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x Int
off ByteArray
b Int
0 (CSize -> Int
csizeToInt CSize
len)
      CSsize -> IO (Either Errno CSize)
errorsFromSize (CSsize -> IO (Either Errno CSize))
-> IO CSsize -> IO (Either Errno CSize)
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

{- | Copy and pin a byte array if, it's not already pinned.
pinByteArray :: ByteArray -> IO (Maybe ByteArray)
{\-# INLINE pinByteArray #-\}
pinByteArray byteArray =
  if isByteArrayPinned byteArray
    then
      pure Nothing
    else do
      pinnedByteArray <- PM.newPinnedByteArray len
      PM.copyByteArray pinnedByteArray 0 byteArray 0 len
      r <- PM.unsafeFreezeByteArray pinnedByteArray
      pure (Just r)
  where
    len = PM.sizeofByteArray byteArray
-}

{- | Send two payloads (one from unmanaged memory and one from
managed memory) over a network socket.
-}
uninterruptibleSendMessageA ::
  -- | Socket
  Fd ->
  -- | Source address (payload A)
  Addr ->
  -- | Length in bytes (payload A)
  CSize ->
  -- | Source and offset (payload B)
  MutableByteArrayOffset RealWorld ->
  -- | Length in bytes (payload B)
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendMessageA :: Fd
-> Addr
-> CSize
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageA
  Fd
fd
  (Addr Addr#
addr)
  CSize
lenA
  (MutableByteArrayOffset {MutableByteArray RealWorld
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
  MessageFlags 'Send
flags =
    Fd
-> Addr#
-> CSize
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_unsafe_sendmsg_a Fd
fd Addr#
addr CSize
lenA (MutableByteArray RealWorld -> MutableByteArray# RealWorld
forall s. MutableByteArray s -> MutableByteArray# s
unMba MutableByteArray RealWorld
array) Int
offset CSize
lenB MessageFlags 'Send
flags
      IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source and offset (payload B)
  MutableByteArrayOffset RealWorld ->
  -- | Length in bytes (payload B)
  CSize ->
  -- | Source address (payload A)
  Addr ->
  -- | Length in bytes (payload A)
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendMessageB :: Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> Addr
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMessageB
  Fd
fd
  (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
  (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 (MutableByteArray RealWorld -> MutableByteArray# RealWorld
forall s. MutableByteArray s -> MutableByteArray# s
unMba MutableByteArray RealWorld
array) Int
offset CSize
lenB Addr#
addr CSize
lenA MessageFlags 'Send
flags
      IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  MutableByteArray RealWorld ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
sendMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
sendMutableByteArray Fd
fd b :: MutableByteArray RealWorld
b@(MutableByteArray MutableByteArray# RealWorld
b#) Int
off CSize
len MessageFlags 'Send
flags =
  if MutableByteArray RealWorld -> Bool
forall s. MutableByteArray s -> Bool
isMutableByteArrayPinned MutableByteArray RealWorld
b
    then CSsize -> IO (Either Errno CSize)
errorsFromSize (CSsize -> IO (Either Errno CSize))
-> IO CSsize -> IO (Either Errno CSize)
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#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
      MutableByteArray (PrimState IO)
-> Int -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x Int
off MutableByteArray RealWorld
MutableByteArray (PrimState IO)
b Int
0 (CSize -> Int
csizeToInt CSize
len)
      CSsize -> IO (Either Errno CSize)
errorsFromSize (CSsize -> IO (Either Errno CSize))
-> IO CSsize -> IO (Either Errno CSize)
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 ::
  -- | Connected socket
  Fd ->
  -- | Source address
  Addr ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
send :: Fd
-> Addr -> CSize -> MessageFlags 'Send -> IO (Either Errno CSize)
send Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Send
flags =
  Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
c_safe_addr_send Fd
fd Addr#
addr CSize
len MessageFlags 'Send
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source address
  Addr ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSend :: Fd
-> Addr -> CSize -> MessageFlags 'Send -> IO (Either Errno CSize)
uninterruptibleSend Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Send
flags =
  Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize
c_unsafe_addr_send Fd
fd Addr#
addr CSize
len MessageFlags 'Send
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags =
  Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize
c_unsafe_bytearray_send Fd
fd ByteArray#
b Int
off CSize
len MessageFlags 'Send
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source mutable byte array
  MutableByteArray RealWorld ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO (Either Errno CSize)
uninterruptibleSendMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags =
  Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> IO CSsize
c_unsafe_mutable_bytearray_send Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Send
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Socket Address
  SocketAddress ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendToByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddress a :: ByteArray
a@(ByteArray ByteArray#
a#)) =
  Fd
-> ByteArray#
-> Int
-> CSize
-> MessageFlags 'Send
-> ByteArray#
-> CInt
-> IO CSsize
c_unsafe_bytearray_sendto Fd
fd ByteArray#
b Int
off CSize
len MessageFlags 'Send
flags ByteArray#
a# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
a)) IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Socket Address
  SocketAddressInternet ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendToInternetByteArray :: Fd
-> ByteArray
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetByteArray Fd
fd (ByteArray ByteArray#
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddressInternet {Word16
port :: Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port, Word32
address :: Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> 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 IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  Addr ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Socket Address
  SocketAddressInternet ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendToInternet :: Fd
-> Addr
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternet Fd
fd (Addr Addr#
b) CSize
len MessageFlags 'Send
flags (SocketAddressInternet {Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port :: Word16
port, Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address :: 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 IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  MutableByteArray RealWorld ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Socket Address
  SocketAddress ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendToMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddress
-> IO (Either Errno CSize)
uninterruptibleSendToMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddress a :: ByteArray
a@(ByteArray ByteArray#
a#)) =
  Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> ByteArray#
-> CInt
-> IO CSsize
c_unsafe_mutable_bytearray_sendto Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Send
flags ByteArray#
a# (Int -> CInt
intToCInt (ByteArray -> Int
PM.sizeofByteArray ByteArray
a)) IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source byte array
  MutableByteArray RealWorld ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Send ->
  -- | Socket Address
  SocketAddressInternet ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleSendToInternetMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Send
-> SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleSendToInternetMutableByteArray Fd
fd (MutableByteArray MutableByteArray# RealWorld
b) Int
off CSize
len MessageFlags 'Send
flags (SocketAddressInternet {Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port :: Word16
port, Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address :: 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 IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Source address
  Addr ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  IO (Either Errno CSize)
receive :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
receive Fd
fd (Addr Addr#
addr) CSize
len MessageFlags 'Receive
flags =
  Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_safe_addr_recv Fd
fd Addr#
addr CSize
len MessageFlags 'Receive
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  IO (Either Errno ByteArray)
receiveByteArray :: Fd -> CSize -> MessageFlags 'Receive -> IO (Either Errno ByteArray)
receiveByteArray !Fd
fd !CSize
len !MessageFlags 'Receive
flags = do
  MutableByteArray RealWorld
m <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray (CSize -> Int
csizeToInt CSize
len)
  let !(Addr Addr#
addr) = Ptr Word8 -> Addr
ptrToAddr (MutableByteArray RealWorld -> Ptr Word8
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 CSsize -> CSsize -> Bool
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 <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
sz
      MutableByteArray (PrimState IO)
-> Int -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PM.copyMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x Int
0 MutableByteArray RealWorld
MutableByteArray (PrimState IO)
m Int
0 Int
sz
      ByteArray
a <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
x
      Either Errno ByteArray -> IO (Either Errno ByteArray)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Either Errno ByteArray
forall a b. b -> Either a b
Right ByteArray
a)
    else (Errno -> Either Errno ByteArray)
-> IO Errno -> IO (Either Errno ByteArray)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno ByteArray
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 ::
  -- | Socket
  Fd ->
  -- | Source address
  Addr ->
  -- | Length in bytes
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceive #-}
uninterruptibleReceive :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceive !Fd
fd (Addr !Addr#
addr) !CSize
len !MessageFlags 'Receive
flags =
  Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_unsafe_addr_recv Fd
fd Addr#
addr CSize
len MessageFlags 'Receive
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  MutableByteArray RealWorld ->
  -- | Destination offset
  Int ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Bytes received into array
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceiveMutableByteArray #-}
uninterruptibleReceiveMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveMutableByteArray !Fd
fd (MutableByteArray !MutableByteArray# RealWorld
b) !Int
off !CSize
len !MessageFlags 'Receive
flags =
  Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO CSsize
c_unsafe_mutable_byte_array_recv Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  MutableByteArray RealWorld ->
  -- | Destination offset
  Int ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Maximum socket address size
  CInt ->
  -- | Remote host, bytes received into array, bytes needed for @addrlen@.
  IO (Either Errno (CInt, SocketAddress, CSize))
{-# 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#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
cintToInt CInt
maxSz)
  lenBuf :: MutableByteArray RealWorld
lenBuf@(MutableByteArray MutableByteArray# RealWorld
lenBuf#) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CInt -> Int
forall a. Prim a => a -> Int
PM.sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
  MutableByteArray (PrimState IO) -> Int -> CInt -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
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 CSsize -> CSsize -> Bool
forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
    then do
      (CInt
sz :: CInt) <- MutableByteArray (PrimState IO) -> Int -> IO CInt
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PM.readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
lenBuf Int
0
      if CInt
sz CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
maxSz
        then MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
sockAddrBuf (CInt -> Int
cintToInt CInt
sz)
        else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ByteArray
sockAddr <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
sockAddrBuf
      Either Errno (CInt, SocketAddress, CSize)
-> IO (Either Errno (CInt, SocketAddress, CSize))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CInt, SocketAddress, CSize)
-> Either Errno (CInt, SocketAddress, CSize)
forall a b. b -> Either a b
Right (CInt
sz, ByteArray -> SocketAddress
SocketAddress ByteArray
sockAddr, CSsize -> CSize
cssizeToCSize CSsize
r))
    else (Errno -> Either Errno (CInt, SocketAddress, CSize))
-> IO Errno -> IO (Either Errno (CInt, SocketAddress, CSize))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno (CInt, SocketAddress, CSize)
forall a b. a -> Either a b
Left IO Errno
getErrno

uninterruptibleReceiveFromInternet ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  Addr ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Address
  MutablePrimArrayOffset RealWorld SocketAddressInternet ->
  -- | Number of bytes received into array
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceiveFromInternet #-}
uninterruptibleReceiveFromInternet :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleReceiveFromInternet
  !Fd
fd
  (Addr Addr#
b)
  !CSize
len
  !MessageFlags 'Receive
flags
  (MutablePrimArrayOffset (MutablePrimArray MutableByteArray# RealWorld
sockAddrBuf) Int
addrOff) =
    Fd
-> Addr#
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
c_unsafe_recvfrom_inet_addr Fd
fd Addr#
b CSize
len MessageFlags 'Receive
flags MutableByteArray# RealWorld
sockAddrBuf Int
addrOff
      IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

uninterruptibleReceiveFromInternetMutableByteArray ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  MutableByteArrayOffset RealWorld ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Address
  MutablePrimArrayOffset RealWorld SocketAddressInternet ->
  -- | Number of bytes received into array
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceiveFromInternetMutableByteArray #-}
uninterruptibleReceiveFromInternetMutableByteArray :: Fd
-> MutableByteArrayOffset RealWorld
-> CSize
-> MessageFlags 'Receive
-> MutablePrimArrayOffset RealWorld SocketAddressInternet
-> IO (Either Errno CSize)
uninterruptibleReceiveFromInternetMutableByteArray
  !Fd
fd
  (MutableByteArrayOffset (MutableByteArray MutableByteArray# RealWorld
b) Int
off)
  !CSize
len
  !MessageFlags 'Receive
flags
  (MutablePrimArrayOffset (MutablePrimArray MutableByteArray# RealWorld
sockAddrBuf) Int
addrOff) =
    Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> MutableByteArray# RealWorld
-> Int
-> IO CSsize
c_unsafe_recvfrom_inet Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags MutableByteArray# RealWorld
sockAddrBuf Int
addrOff
      IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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_ ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  MutableByteArray RealWorld ->
  -- | Destination offset
  Int ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Number of bytes received into array
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceiveFromMutableByteArray_ #-}
uninterruptibleReceiveFromMutableByteArray_ :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveFromMutableByteArray_ !Fd
fd (MutableByteArray !MutableByteArray# RealWorld
b) !Int
off !CSize
len !MessageFlags 'Receive
flags =
  Fd
-> MutableByteArray# RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO CSsize
c_unsafe_mutable_byte_array_peerless_recvfrom Fd
fd MutableByteArray# RealWorld
b Int
off CSize
len MessageFlags 'Receive
flags
    IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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_ ::
  -- | Socket
  Fd ->
  -- | Destination byte array
  Addr ->
  -- | Maximum bytes to receive
  CSize ->
  -- | Flags
  MessageFlags 'Receive ->
  -- | Number of bytes received into array
  IO (Either Errno CSize)
{-# INLINE uninterruptibleReceiveFrom_ #-}
uninterruptibleReceiveFrom_ :: Fd
-> Addr
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
uninterruptibleReceiveFrom_ !Fd
fd (Addr !Addr#
b) !CSize
len !MessageFlags 'Receive
flags =
  Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize
c_unsafe_addr_peerless_recvfrom Fd
fd Addr#
b CSize
len MessageFlags 'Receive
flags
    IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
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 IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 CSsize -> CSsize -> Bool
forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
    then Either Errno CSize -> IO (Either Errno CSize)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CSize -> Either Errno CSize
forall a b. b -> Either a b
Right (CSsize -> CSize
cssizeToCSize CSsize
r))
    else (Errno -> Either Errno CSize)
-> IO Errno -> IO (Either Errno CSize)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno CSize
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 Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
    then Either Errno Fd -> IO (Either Errno Fd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd -> Either Errno Fd
forall a b. b -> Either a b
Right Fd
r)
    else (Errno -> Either Errno Fd) -> IO Errno -> IO (Either Errno Fd)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno Fd
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 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
    then Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
    else (Errno -> Either Errno ()) -> IO Errno -> IO (Either Errno ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno ()
forall a b. a -> Either a b
Left IO Errno
getErrno

intToCInt :: Int -> CInt
intToCInt :: Int -> CInt
intToCInt = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

cintToInt :: CInt -> Int
cintToInt :: CInt -> Int
cintToInt = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

csizeToInt :: CSize -> Int
csizeToInt :: CSize -> Int
csizeToInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

cssizeToInt :: CSsize -> Int
cssizeToInt :: CSsize -> Int
cssizeToInt = CSsize -> Int
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 = CSsize -> CSize
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) =
  (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
PM.primitive_ (MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> State# RealWorld
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 -> Word16 -> Word16
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 -> Word16 -> Word16
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 -> Word32 -> Word32
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 -> Word32 -> Word32
forall a. a -> a
id
  ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32

{- $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# (MutableByteArray# s -> Int#
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