{-# OPTIONS_GHC -optc-DHAVE_SOCKET_WITH_FLAGS #-}
{-# OPTIONS_GHC -optc-DHAVE_ACCEPT_WITH_FLAGS #-}
{-# LINE 1 "src/System/Posix/Socket.hsc" #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LINE 2 "src/System/Posix/Socket.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}

-- | POSIX sockets.
module System.Posix.Socket
  ( Socket
  , withSocketFd
  , unsafeSocketFd
  , unsafeSocketFromFd
  , SockFamily(..)
  , SockAddr(..)
  , SockType(..)
  , streamSockType
  , datagramSockType
  , rawSockType
  , seqPacketSockType
  , SockProto(..)
  , defaultSockProto
  , SockOpt(..)
  , SO_ERROR(..)
  , SO_KEEPALIVE(..)
  , SO_REUSEADDR(..)
  , SockOps
  , sendSockOp
  , recvSockOp
  , MsgFlags
  , peekMsgFlag
  , truncMsgFlag
  , oobMsgFlag
  , dontRouteMsgFlag

  , socket
  , getSockOpt
  , setSockOpt
  , bind
  , connect
  , tryConnect
  , listen
  , accept
  , getLocalAddr
  , getRemoteAddr
  , hasOobData
  , recvBufs
  , recvBuf
  , recv'
  , recv
  , recvBufsFrom
  , recvBufFrom
  , recvFrom'
  , recvFrom
  , sendBufs
  , sendMany'
  , sendMany
  , sendBuf
  , send'
  , send
  , sendBufsTo
  , sendManyTo'
  , sendManyTo
  , sendBufTo
  , sendTo'
  , sendTo
  , shutdown
  , close
  ) where

import Data.Typeable (Typeable)
import Data.Proxy (Proxy(..))
import Data.Word
import Data.Bits ((.|.))
import Data.Default.Class
import Data.List (partition)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Flags (Flags(..), (.>=.))
import Data.Flags.TH (bitmaskWrapper)
import Data.Foldable (forM_)
import Control.Applicative ((<$>))
import Control.Monad (void, when, foldM)
import Control.Monad.Base
import Control.Exception (throwIO)
import Control.Concurrent (threadWaitRead, threadWaitWrite)
import Control.Concurrent.MVar
import Foreign.Storable (Storable(..))
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytesAligned)
import Foreign.Marshal.Utils (with)

{-# LINE 100 "src/System/Posix/Socket.hsc" #-}
import Foreign.C.Types (CInt(..), CSize(..))
import System.Posix.Types (CSsize(..))

{-# LINE 106 "src/System/Posix/Socket.hsc" #-}
import Foreign.C.Error (Errno(..), eOK, eINVAL, eMSGSIZE, eINPROGRESS, eAGAIN,
                        eWOULDBLOCK, getErrno, errnoToIOError,
                        throwErrno, throwErrnoIfMinus1, throwErrnoIfMinus1_)
import System.IO.Error (eofErrorType, mkIOError)
import System.Posix.Types (Fd(..))
import System.Posix.IO (closeFd)
import GHC.Conc (closeFdWith)


{-# LINE 115 "src/System/Posix/Socket.hsc" #-}

{-# LINE 116 "src/System/Posix/Socket.hsc" #-}

{-# LINE 117 "src/System/Posix/Socket.hsc" #-}

{-# LINE 118 "src/System/Posix/Socket.hsc" #-}

{-# LINE 119 "src/System/Posix/Socket.hsc" #-}

{-# LINE 120 "src/System/Posix/Socket.hsc" #-}

{-# LINE 121 "src/System/Posix/Socket.hsc" #-}

{-# LINE 122 "src/System/Posix/Socket.hsc" #-}

{-# LINE 123 "src/System/Posix/Socket.hsc" #-}


{-# LINE 127 "src/System/Posix/Socket.hsc" #-}


{-# LINE 129 "src/System/Posix/Socket.hsc" #-}

{-# LINE 130 "src/System/Posix/Socket.hsc" #-}

{-# LINE 131 "src/System/Posix/Socket.hsc" #-}

-- | Socket of a particular family.
newtype Socket f = Socket (MVar Fd) deriving (Typeable, Eq)

-- | Lock the socket and pass the underlying file descriptor to the given
--   action.
withSocketFd ∷ MonadBase IO μ ⇒ Socket f → (Fd → IO α) → μ α
withSocketFd (Socket v) f = liftBase $ withMVar v f
{-# INLINE withSocketFd #-}

-- | Get the underlying file descriptor.
unsafeSocketFd ∷ MonadBase IO μ ⇒ Socket f → μ Fd
unsafeSocketFd (Socket v) = liftBase $ readMVar v

-- | Use file descriptor as a socket.
unsafeSocketFromFd ∷ MonadBase IO μ ⇒ Fd → μ (Socket f)
unsafeSocketFromFd = liftBase . fmap Socket . newMVar

-- | Socket address.
class SockAddr a where
  -- | Maximum size of a socket address.
  sockAddrMaxSize ∷ Proxy a → Int
  -- | Size of a particular socket address.
  sockAddrSize    ∷ a → Int
  -- | Read socket address from a memory buffer.
  peekSockAddr    ∷ Ptr a -- ^ Buffer
                  → Int   -- ^ Buffer size
                  → IO a
  -- | Write socket address to a memory buffer.
  pokeSockAddr    ∷ Ptr a -- ^ Buffer of sufficient size
                  → a     -- ^ The address to poke
                  → IO ()

-- | Socket family.
class SockAddr (SockFamilyAddr f) ⇒ SockFamily f where
  type SockFamilyAddr f
  -- | Socket family code.
  sockFamilyCode ∷ f → CInt

-- | Socket type.
newtype SockType = SockType CInt deriving (Typeable, Eq, Ord, Show, Storable)

-- | See /SOCK_STREAM/.
streamSockType ∷ SockType
streamSockType = SockType 1
{-# LINE 176 "src/System/Posix/Socket.hsc" #-}

-- | See /SOCK_DGRAM/.
datagramSockType ∷ SockType
datagramSockType = SockType 2
{-# LINE 180 "src/System/Posix/Socket.hsc" #-}

-- | See /SOCK_RAW/.
rawSockType ∷ SockType
rawSockType = SockType 3
{-# LINE 184 "src/System/Posix/Socket.hsc" #-}

-- | See /SOCK_SEQPACKET/.
seqPacketSockType ∷ SockType
seqPacketSockType = SockType 5
{-# LINE 188 "src/System/Posix/Socket.hsc" #-}

-- | Socket protocol.
newtype SockProto = SockProto CInt deriving (Typeable, Eq, Ord, Show, Storable)

-- | Default socket protocol (corresponds to @0@).
defaultSockProto ∷ SockProto
defaultSockProto = SockProto 0

instance Default SockProto where
  def = defaultSockProto

-- | Socket option.
class Storable (SockOptRaw o) ⇒ SockOpt o where
  -- | Option value type
  type SockOptValue o
  -- | FFI-level option value type
  type SockOptRaw o
  -- | Whether option is readable
  type SockOptReadable o ∷ Bool
  -- | Whether option is writable
  type SockOptWritable o ∷ Bool
  -- | Convert to FFI-level value
  sockOptRaw   ∷ o → SockOptValue o → SockOptRaw o
  -- | Convert from FFI-level value
  sockOptValue ∷ o → SockOptRaw o → SockOptValue o
  -- | Option protocol level
  sockOptLevel ∷ o → CInt
  -- | Option code
  sockOptCode  ∷ o → CInt

data SO_ERROR = SO_ERROR deriving (Typeable, Eq, Show)

instance SockOpt SO_ERROR where
  type SockOptValue    SO_ERROR = Errno
  type SockOptRaw      SO_ERROR = CInt
  type SockOptReadable SO_ERROR = 'True
  type SockOptWritable SO_ERROR = 'False
  sockOptRaw   _ (Errno e) = e
  sockOptValue _ = Errno
  sockOptLevel _ = 1
{-# LINE 228 "src/System/Posix/Socket.hsc" #-}
  sockOptCode  _ = 4
{-# LINE 229 "src/System/Posix/Socket.hsc" #-}

data SO_KEEPALIVE = SO_KEEPALIVE deriving (Typeable, Eq, Show)

instance SockOpt SO_KEEPALIVE where
  type SockOptValue    SO_KEEPALIVE = Bool
  type SockOptRaw      SO_KEEPALIVE = CInt
  type SockOptReadable SO_KEEPALIVE = 'True
  type SockOptWritable SO_KEEPALIVE = 'True
  sockOptRaw _ False = 0
  sockOptRaw _ True  = 1
  sockOptValue _ = (/= 0)
  sockOptLevel _ = 1
{-# LINE 241 "src/System/Posix/Socket.hsc" #-}
  sockOptCode  _ = 9
{-# LINE 242 "src/System/Posix/Socket.hsc" #-}

data SO_REUSEADDR = SO_REUSEADDR deriving (Typeable, Eq, Show)

instance SockOpt SO_REUSEADDR where
  type SockOptValue    SO_REUSEADDR = Bool
  type SockOptRaw      SO_REUSEADDR = CInt
  type SockOptReadable SO_REUSEADDR = 'True
  type SockOptWritable SO_REUSEADDR = 'True
  sockOptRaw _ False = 0
  sockOptRaw _ True  = 1
  sockOptValue _ = (/= 0)
  sockOptLevel _ = 1
{-# LINE 254 "src/System/Posix/Socket.hsc" #-}
  sockOptCode  _ = 2
{-# LINE 255 "src/System/Posix/Socket.hsc" #-}

-- | Socket operations. Used by 'shutdown'.
$(bitmaskWrapper "SockOps" ''Int []
    [("sendSockOp", 1),
     ("recvSockOp", 2)])

-- | Message flags.
newtype MsgFlags = MsgFlags CInt deriving (Typeable, Eq, Show, Storable, Flags)

-- | See /MSG_PEEK/.
peekMsgFlag ∷ MsgFlags
peekMsgFlag = MsgFlags 2
{-# LINE 267 "src/System/Posix/Socket.hsc" #-}

-- | See /MSG_TRUNC/.
truncMsgFlag ∷ MsgFlags
truncMsgFlag = MsgFlags 32
{-# LINE 271 "src/System/Posix/Socket.hsc" #-}

-- | See /MSG_OOB/.
oobMsgFlag ∷ MsgFlags
oobMsgFlag = MsgFlags 1
{-# LINE 275 "src/System/Posix/Socket.hsc" #-}

-- | See /MSG_DONTROUTE/.
dontRouteMsgFlag ∷ MsgFlags
dontRouteMsgFlag = MsgFlags 4
{-# LINE 279 "src/System/Posix/Socket.hsc" #-}

allocaMaxAddr ∷ SockAddr a ⇒ Proxy a → (Ptr a → Word32 → IO α) → IO α
{-# LINE 281 "src/System/Posix/Socket.hsc" #-}
allocaMaxAddr addrProxy f =
    allocaBytesAligned size (2) $
{-# LINE 283 "src/System/Posix/Socket.hsc" #-}
      (`f` (fromIntegral size))
  where size = sockAddrMaxSize addrProxy

allocaAddr ∷ SockAddr a ⇒ a → (Ptr a → Word32 → IO α) → IO α
{-# LINE 287 "src/System/Posix/Socket.hsc" #-}
allocaAddr addr f =
    allocaBytesAligned size (2) $
{-# LINE 289 "src/System/Posix/Socket.hsc" #-}
      (`f` (fromIntegral size))
  where size = sockAddrSize addr

peekAddrOfSize ∷ SockFamily f
               ⇒ f → Ptr (SockFamilyAddr f) → Ptr Word32
{-# LINE 294 "src/System/Posix/Socket.hsc" #-}
               → IO (SockFamilyAddr f)
peekAddrOfSize fam p pSize = do
  outSize ← fromIntegral <$> peek pSize
  famCode ∷ Word16 ← (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 298 "src/System/Posix/Socket.hsc" #-}
  when (fromIntegral famCode /= sockFamilyCode fam) $
    ioError $ userError "Invalid socket address family"
  peekSockAddr p outSize

withAddr ∷ SockFamily f
         ⇒ f
         → SockFamilyAddr f
         → (Ptr (SockFamilyAddr f) → Word32 → IO α)
{-# LINE 306 "src/System/Posix/Socket.hsc" #-}
         → IO α
withAddr fam addr f =
    allocaAddr addr $ \p size → do
      pokeSockAddr p addr
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) p famCode
{-# LINE 311 "src/System/Posix/Socket.hsc" #-}
      f p size
  where famCode ∷ Word16
{-# LINE 313 "src/System/Posix/Socket.hsc" #-}
        famCode = fromIntegral $ sockFamilyCode fam

-- | Create a socket. See /socket(3)/.
-- The underlying file descriptor is non-blocking.
socket ∷ (SockFamily f, MonadBase IO μ)
       ⇒ f → SockType → SockProto → μ (Socket f)
socket f (SockType t) p = liftBase $ do
  fd ← throwErrnoIfMinus1 "socket" $
         c_socket (sockFamilyCode f)

{-# LINE 323 "src/System/Posix/Socket.hsc" #-}
           (t .|. 2048) p
{-# LINE 324 "src/System/Posix/Socket.hsc" #-}

{-# LINE 328 "src/System/Posix/Socket.hsc" #-}
  fmap Socket $ newMVar $ Fd fd

getFdOpt ∷ ∀ o . (SockOpt o, SockOptReadable o ~ 'True)
         ⇒ Fd → o → IO (SockOptValue o)
getFdOpt fd o =
  alloca $ \p →
    with (fromIntegral $ sizeOf (undefined ∷ SockOptRaw o)) $ \pSize → do
      throwErrnoIfMinus1_ "getSockOpt" $
        c_getsockopt fd (sockOptLevel o) (sockOptCode o) p pSize
      sockOptValue o <$> peek p

-- | Get socket option value. See /getsockopt(3)/.
getSockOpt ∷ (SockOpt o, SockOptReadable o ~ 'True, MonadBase IO μ)
           ⇒ Socket f → o → μ (SockOptValue o)
getSockOpt s o = withSocketFd s $ \fd → getFdOpt fd o

-- | Set socket option value. See /setsockopt(3)/.
setSockOpt ∷ (SockOpt o, SockOptWritable o ~ 'True, MonadBase IO μ)
           ⇒ Socket f → o → SockOptValue o → μ ()
setSockOpt s o v = withSocketFd s $ \fd →
    with raw $ \p →
      throwErrnoIfMinus1_ "setSockOpt" $
        c_setsockopt fd (sockOptLevel o) (sockOptCode o) p $
          fromIntegral (sizeOf raw)
  where raw = sockOptRaw o v

-- | Bind socket to the specified address. See /bind(3)/.
bind ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
     ⇒ Socket f → SockFamilyAddr f → μ ()
bind s addr = withSocketFd s $ \fd →
  withAddr (undefined ∷ f) addr $ \p size →
    throwErrnoIfMinus1_ "bind" $ c_bind fd p $ fromIntegral size

-- | Connect socket to the specified address. This function blocks.
-- See /connect(3)/.
connect ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
        ⇒ Socket f → SockFamilyAddr f → μ ()
connect s addr = withSocketFd s $ \fd →
    withAddr (undefined ∷ f) addr $ \p size →
      doConnect fd p $ fromIntegral size
  where doConnect fd p size = do
          r ← c_connect fd p size
          if r == -1 then do
            errno ← getErrno
            case errno of
              e | e == eINPROGRESS → do
                threadWaitWrite fd
                errno' ← getFdOpt fd SO_ERROR
                when (errno' /= eOK) $
                  throwIO $ errnoToIOError "connect" errno' Nothing Nothing
              _ → throwErrno "connect"
          else
            return ()

-- | Try to connect socket without blocking. On success 'True' is returned.
-- If the connection did not succeed immediately, 'False' is returned.
-- See /connect(3)/.
tryConnect ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
           ⇒ Socket f → SockFamilyAddr f → μ Bool
tryConnect s addr = withSocketFd s $ \fd →
  withAddr (undefined ∷ f) addr $ \p size → do
    r ← c_connect fd p $ fromIntegral size
    if r == -1
      then do
        errno ← getErrno
        if errno == eINPROGRESS
          then return False
          else throwErrno "connect"
      else
        return True

-- | Listen for connections on the given socket. See /listen(2)/.
listen ∷ MonadBase IO μ ⇒ Socket f → Int → μ ()
listen s backlog = withSocketFd s $ \fd →
  throwErrnoIfMinus1_ "listen" $ c_listen fd $ fromIntegral backlog

-- | Accept a connection on the given socket. This function blocks.
-- See /accept(2)/.
accept ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
       ⇒ Socket f → μ (Socket f, SockFamilyAddr f)
accept s = withSocketFd s $ \fd →
    allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \p size →
      with size $ \pSize → doAccept fd p pSize
  where doAccept fd p pSize = do
          cfd ← c_accept fd p pSize

{-# LINE 414 "src/System/Posix/Socket.hsc" #-}
                  2048
{-# LINE 415 "src/System/Posix/Socket.hsc" #-}

{-# LINE 416 "src/System/Posix/Socket.hsc" #-}
          if cfd == -1 then do
            errno ← getErrno
            case errno of
              e | e == eAGAIN || e == eWOULDBLOCK → do
                threadWaitRead fd
                doAccept fd p pSize
              _ → throwErrno "accept"
          else do
            addr ← peekAddrOfSize (undefined ∷ f) p pSize

{-# LINE 428 "src/System/Posix/Socket.hsc" #-}
            (, addr) <$> unsafeSocketFromFd (Fd cfd)

-- | Get the local address. See /getsockname(3)/.
getLocalAddr ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
             ⇒ Socket f → μ (SockFamilyAddr f)
getLocalAddr s = withSocketFd s $ \fd →
  allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \p size →
    with size $ \pSize → do
      throwErrnoIfMinus1_ "getLocalAddr" $ c_getsockname fd p pSize
      peekAddrOfSize (undefined ∷ f) p pSize

-- | Get the remote address. See /getpeername(3)/.
getRemoteAddr ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
              ⇒ Socket f → μ (SockFamilyAddr f)
getRemoteAddr s = withSocketFd s $ \fd →
  allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \p size →
    with size $ \pSize → do
      throwErrnoIfMinus1_ "getRemoteAddr" $ c_getpeername fd p pSize
      peekAddrOfSize (undefined ∷ f) p pSize

-- | Check if socket has out-of-band data. See /sockatmark(3)/.
hasOobData ∷ MonadBase IO μ ⇒ Socket f → μ Bool
hasOobData s = withSocketFd s $ \fd →
  fmap (== 1) $ throwErrnoIfMinus1 "hasOOBData" $ c_sockatmark fd

throwCustomErrno ∷ String → Errno → IO α
throwCustomErrno loc errno =
  throwIO $ errnoToIOError loc errno Nothing Nothing

throwInval ∷ String → IO α
throwInval loc = throwCustomErrno loc eINVAL

recvBufsFromFd ∷ ∀ f . SockFamily f
               ⇒ f → Fd → [(Ptr Word8, Int)] → MsgFlags
               → IO (Maybe (SockFamilyAddr f), Int, MsgFlags)
recvBufsFromFd _ fd bufs' flags = do
  let (bufs, bufs'') = partition ((> 0) . snd) bufs'
      nn             = length bufs
  when (any ((< 0) . snd) bufs'' || nn == 0) $ throwInval "recv"
  when (nn > 1024) $ throwCustomErrno "recv" eMSGSIZE
{-# LINE 468 "src/System/Posix/Socket.hsc" #-}
  allocaBytesAligned (56)
{-# LINE 469 "src/System/Posix/Socket.hsc" #-}
                     (8) $ \pHdr →
{-# LINE 470 "src/System/Posix/Socket.hsc" #-}
    allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \pAddr addrLen → do
      (\hsc_ptr -> pokeByteOff hsc_ptr 0)    pHdr pAddr
{-# LINE 472 "src/System/Posix/Socket.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) pHdr addrLen
{-# LINE 473 "src/System/Posix/Socket.hsc" #-}
      let doRecv = do
            r ← c_recvmsg fd pHdr flags
            case r of
              (-1) → do
                errno ← getErrno
                case errno of
                  e | e == eAGAIN || e == eWOULDBLOCK → do
                    threadWaitRead fd
                    doRecv
                  _ → throwErrno "recv"
              0 → throwIO $ mkIOError eofErrorType "recv" Nothing Nothing
              _ → do
                addrLen' ← (\hsc_ptr -> peekByteOff hsc_ptr 8) pHdr ∷
{-# LINE 486 "src/System/Posix/Socket.hsc" #-}
                              IO Word32
{-# LINE 487 "src/System/Posix/Socket.hsc" #-}
                addr     ← if addrLen' == 0
                             then return Nothing
                             else fmap Just $ peekSockAddr pAddr $
                                    fromIntegral addrLen'
                flags'   ← (\hsc_ptr -> peekByteOff hsc_ptr 48) pHdr
{-# LINE 492 "src/System/Posix/Socket.hsc" #-}
                return (addr, fromIntegral r, flags')
      allocaBytesAligned (nn * (16))
{-# LINE 494 "src/System/Posix/Socket.hsc" #-}
                         (8) $ \pIoVs → do
{-# LINE 495 "src/System/Posix/Socket.hsc" #-}
        void . ($ bufs) . ($ pIoVs) . foldM $ \pIoV (p, n) → do
          (\hsc_ptr -> pokeByteOff hsc_ptr 0) pIoV p
{-# LINE 497 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 8)  pIoV (fromIntegral n ∷ CSize)
{-# LINE 498 "src/System/Posix/Socket.hsc" #-}
          return $ plusPtr pIoV (16)
{-# LINE 499 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16)        pHdr pIoVs
{-# LINE 500 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 24)     pHdr (fromIntegral nn ∷ CSize)
{-# LINE 501 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 32)    pHdr nullPtr
{-# LINE 502 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 40) pHdr (0 ∷ CSize)
{-# LINE 503 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 48)      pHdr (0 ∷ CInt)
{-# LINE 504 "src/System/Posix/Socket.hsc" #-}
        doRecv

recvBufsFrom' ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
              ⇒ Socket f → [(Ptr Word8, Int)] → MsgFlags
              → μ (Maybe (SockFamilyAddr f), Int, MsgFlags)
recvBufsFrom' s bufs flags = withSocketFd s $ \fd →
  recvBufsFromFd (undefined ∷ f) fd bufs flags

-- | Receive a message from a connected socket, possibly utilizing multiple
-- memory buffers. See /recvmsg(3)/.
recvBufs ∷ (SockFamily f, MonadBase IO μ)
         ⇒ Socket f           -- ^ The socket
         → [(Ptr Word8, Int)] -- ^ Memory buffers
         → MsgFlags           -- ^ Message flags
         → μ (Int, MsgFlags)  -- ^ Received message length and flags
recvBufs s bufs flags = do
  (_, r, flags') ← recvBufsFrom' s bufs flags
  return (r, flags')

-- | Receive a message from a connected socket. See /recvmsg(3)/.
recvBuf ∷ (SockFamily f, MonadBase IO μ)
        ⇒ Socket f          -- ^ The socket
        → Ptr α             -- ^ Buffer pointer
        → Int               -- ^ Buffer length
        → MsgFlags          -- ^ Message flags
        → μ (Int, MsgFlags) -- ^ Received message length and flags
recvBuf s p len flags = recvBufs s [(castPtr p, len)] flags

-- | Receive a message from a connected socket. See /recvmsg(3)/.
recv' ∷ (SockFamily f, MonadBase IO μ)
      ⇒ Socket f                 -- ^ The socket
      → Int                      -- ^ Maximum message length
      → MsgFlags                 -- ^ Message flags
      → μ (ByteString, MsgFlags) -- ^ Received message contents and flags
recv' s len flags =
  liftBase $ BS.createAndTrim' len $ \p → do
    (r, flags') ← recvBuf s p len flags
    return (0, r, flags')

-- | Receive a message from a connected socket. See /recvmsg(3)/.
recv ∷ (SockFamily f, MonadBase IO μ)
     ⇒ Socket f     -- ^ The socket
     → Int          -- ^ Maximum message length
     → μ ByteString -- ^ Received message contents
recv s len = fst <$> recv' s len noFlags

-- | Receive a message from an unconnected socket, possibly utilizing multiple
-- memory buffers. See /recvmsg(3)/.
recvBufsFrom ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
             ⇒ Socket f                            -- ^ The socket
             → [(Ptr Word8, Int)]                  -- ^ Memory buffers
             → MsgFlags                            -- ^ Message flags
             → μ (SockFamilyAddr f, Int, MsgFlags)
             -- ^ Received message source address, length, and flags
recvBufsFrom s bufs flags = withSocketFd s $ \fd → do
  (mAddr, n, flags') ← recvBufsFromFd (undefined ∷ f) fd bufs flags
  let getpeername =
        allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \p size →
          with size $ \pSize → do
            throwErrnoIfMinus1_ "recv" $ c_getpeername fd p pSize
            peekAddrOfSize (undefined ∷ f) p pSize
  (, n, flags') <$> maybe getpeername return mAddr

-- | Receive a message from an unconnected socket. See /recvmsg(3)/.
recvBufFrom ∷ (SockFamily f, MonadBase IO μ)
            ⇒ Socket f -- ^ The socket
            → Ptr α    -- ^ Buffer pointer
            → Int      -- ^ Buffer length
            → MsgFlags -- ^ Message flags
            → μ (SockFamilyAddr f, Int, MsgFlags)
            -- ^ Received message source address, length, and flags
recvBufFrom s p len flags = recvBufsFrom s [(castPtr p, len)] flags

-- | Receive a message from an unconnected socket. See /recvmsg(3)/.
recvFrom' ∷ (SockFamily f, MonadBase IO μ)
          ⇒ Socket f -- ^ The socket
          → Int      -- ^ Maximum message length
          → MsgFlags -- ^ Message flags
          → μ (SockFamilyAddr f, ByteString, MsgFlags)
          -- ^ Received message source address, contents, and flags
recvFrom' s len flags = liftBase $ do
  (bs, (addr, flags')) ← BS.createAndTrim' len $ \p → do
    (addr, len', flags') ← recvBufFrom s p len flags
    return (0, len', (addr, flags'))
  return (addr, bs, flags')

-- | Receive a message from an unconnected socket. See /recvmsg(3)/.
recvFrom ∷ (SockFamily f, MonadBase IO μ)
         ⇒ Socket f -- ^ The socket
         → Int      -- ^ Maximum message length
         → μ (SockFamilyAddr f, ByteString)
         -- ^ Received message source address and contents
recvFrom s len = do
  (addr, bs, _) ← recvFrom' s len noFlags
  return (addr, bs)

_sendBufs ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)
          ⇒ Socket f → [(Ptr Word8, Int)] → MsgFlags
          → Maybe (SockFamilyAddr f) → μ Int
_sendBufs s bufs' flags mAddr = withSocketFd s $ \fd → do
  let (bufs, bufs'') = partition ((> 0) . snd) bufs'
      nn             = length bufs
  when (any ((< 0) . snd) bufs'') $ throwInval "send"
  when (nn > 1024) $ throwCustomErrno "send" eMSGSIZE
{-# LINE 608 "src/System/Posix/Socket.hsc" #-}
  if nn == 0 then return 0
  else allocaBytesAligned (56)
{-# LINE 610 "src/System/Posix/Socket.hsc" #-}
                          (8) $ \pHdr → do
{-# LINE 611 "src/System/Posix/Socket.hsc" #-}
    let doSend = do
          r ← c_sendmsg fd pHdr flags
          if r == -1 then do
            errno ← getErrno
            case errno of
              e | e == eAGAIN || e == eWOULDBLOCK → do
                threadWaitWrite fd
                doSend
              _ → throwErrno "send"
          else
            return $ fromIntegral r
    let cont = allocaBytesAligned (nn * (16))
{-# LINE 623 "src/System/Posix/Socket.hsc" #-}
                                  (8) $ \pIoVs → do
{-# LINE 624 "src/System/Posix/Socket.hsc" #-}
          void . ($ bufs) . ($ pIoVs) . foldM $ \pIoV (p, n) → do
            (\hsc_ptr -> pokeByteOff hsc_ptr 0) pIoV p
{-# LINE 626 "src/System/Posix/Socket.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 8)  pIoV (fromIntegral n ∷ CSize)
{-# LINE 627 "src/System/Posix/Socket.hsc" #-}
            return $ plusPtr pIoV (16)
{-# LINE 628 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 16)        pHdr pIoVs
{-# LINE 629 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 24)     pHdr (fromIntegral nn ∷ CSize)
{-# LINE 630 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 32)    pHdr nullPtr
{-# LINE 631 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 40) pHdr (0 ∷ CSize)
{-# LINE 632 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 48)      pHdr (0 ∷ CInt)
{-# LINE 633 "src/System/Posix/Socket.hsc" #-}
          doSend
    case mAddr of
      Just addr →
        withAddr (undefined ∷ f) addr $ \pAddr addrLen → do
          (\hsc_ptr -> pokeByteOff hsc_ptr 0)    pHdr pAddr
{-# LINE 638 "src/System/Posix/Socket.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 8) pHdr addrLen
{-# LINE 639 "src/System/Posix/Socket.hsc" #-}
          cont
      Nothing → do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0)    pHdr nullPtr
{-# LINE 642 "src/System/Posix/Socket.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) pHdr (0 ∷ Word32)
{-# LINE 643 "src/System/Posix/Socket.hsc" #-}
        cont

-- | Send a message split into several memory buffers on a connected socket.
-- See /sendmsg(3)/.
sendBufs ∷ (SockFamily f, MonadBase IO μ)
         ⇒ Socket f           -- ^ The socket
         → [(Ptr Word8, Int)] -- ^ Memory buffers
         → MsgFlags           -- ^ Message flags
         → μ Int              -- ^ The number of bytes sent 
sendBufs s bufs flags = _sendBufs s bufs flags Nothing

withBufs ∷ [ByteString] → ([(Ptr Word8, Int)] → IO α) → IO α
withBufs bss f = go bss []
  where go []          rbufs = f (reverse rbufs)
        go (bs : bss') rbufs = BS.unsafeUseAsCStringLen bs $ \(p, len) →
                                 go bss' ((castPtr p, len) : rbufs)

-- | Send a message split into several 'ByteString's on a connected socket.
-- See /sendmsg(3)/.
sendMany' ∷ (SockFamily f, MonadBase IO μ)
          ⇒ Socket f     -- ^ The socket
          → [ByteString] -- ^ Message contents
          → MsgFlags     -- ^ Message flags
          → μ Int        -- ^ The number of bytes sent
sendMany' s bss flags =
  liftBase $ withBufs bss $ \bufs → sendBufs s bufs flags

-- | Send a message split into several 'ByteString's on a connected socket.
-- See /sendmsg(3)/.
sendMany ∷ (SockFamily f, MonadBase IO μ)
         ⇒ Socket f     -- ^ The socket
         → [ByteString] -- ^ Message contents
         → μ Int        -- ^ The number of bytes sent
sendMany s bss = sendMany' s bss noFlags

-- | Send a message on a connected socket. See /sendmsg(3)/.
sendBuf ∷ (SockFamily f, MonadBase IO μ)
        ⇒ Socket f -- ^ The socket
        → Ptr α    -- ^ Buffer pointer
        → Int      -- ^ Buffer length
        → MsgFlags -- ^ Message flags
        → μ Int    -- ^ The number of bytes sent
sendBuf s p len flags = sendBufs s [(castPtr p, len)] flags

-- | Send a message on a connected socket. See /sendmsg(3)/.
send' ∷ (SockFamily f, MonadBase IO μ)
      ⇒ Socket f   -- ^ The socket
      → ByteString -- ^ Message contents
      → MsgFlags   -- ^ Message flags
      → μ Int      -- ^ The number of bytes sent
send' s bs flags = liftBase $ BS.unsafeUseAsCStringLen bs $ \(p, len) →
                     sendBuf s p len flags

-- | Send a message on a connected socket. See /sendmsg(3)/.
send ∷ (SockFamily f, MonadBase IO μ)
     ⇒ Socket f   -- ^ The socket
     → ByteString -- ^ Message contents
     → μ Int      -- ^ The number of bytes sent
send s bs = send' s bs noFlags

-- | Send a message split into several memory buffers on an unconnected
-- socket. See /sendmsg(3)/.
sendBufsTo ∷ (SockFamily f, MonadBase IO μ)
           ⇒ Socket f           -- ^ The socket
           → [(Ptr Word8, Int)] -- ^ Memory buffers
           → MsgFlags           -- ^ Message flags
           → SockFamilyAddr f   -- ^ Message destination address
           → μ Int              -- ^ The number of bytes sent
sendBufsTo s bufs flags addr = _sendBufs s bufs flags (Just addr)

-- | Send a message split into several 'ByteString's on an unconnected socket.
-- See /sendmsg(3)/.
sendManyTo' ∷ (SockFamily f, MonadBase IO μ)
            ⇒ Socket f         -- ^ The socket
            → [ByteString]     -- ^ Message contents
            → MsgFlags         -- ^ Message flags
            → SockFamilyAddr f -- ^ Message destination address
            → μ Int            -- ^ The number of bytes sent
sendManyTo' s bss flags addr = liftBase $ withBufs bss $ \bufs →
                                 sendBufsTo s bufs flags addr

-- | Send a message split into several 'ByteString's on an unconnected socket.
-- See /sendmsg(3)/.
sendManyTo ∷ (SockFamily f, MonadBase IO μ)
           ⇒ Socket f         -- ^ The socket
           → [ByteString]     -- ^ Message contents
           → SockFamilyAddr f -- ^ Message destination address
           → μ Int            -- ^ The number of bytes sent
sendManyTo s bss addr = sendManyTo' s bss noFlags addr

-- | Send a message on an unconnected socket. See /sendmsg(3)/.
sendBufTo ∷ (SockFamily f, MonadBase IO μ)
          ⇒ Socket f         -- ^ The socket
          → Ptr α            -- ^ Buffer pointer
          → Int              -- ^ Buffer length
          → MsgFlags         -- ^ Message flags
          → SockFamilyAddr f -- ^ Message destination address
          → μ Int            -- ^ The number of bytes sent
sendBufTo s p len flags addr = sendBufsTo s [(castPtr p, len)] flags addr

-- | Send a message on an unconnected socket. See /sendmsg(3)/.
sendTo' ∷ (SockFamily f, MonadBase IO μ)
        ⇒ Socket f         -- ^ The socket
        → ByteString       -- ^ Message contents
        → MsgFlags         -- ^ Message flags
        → SockFamilyAddr f -- ^ Message destination address
        → μ Int            -- ^ The number of bytes sent
sendTo' s bs flags addr =
  liftBase $ BS.unsafeUseAsCStringLen bs $ \(p, len) →
    sendBufTo s p len flags addr

-- | Send a message on an unconnected socket. See /sendmsg(3)/.
sendTo ∷ (SockFamily f, MonadBase IO μ)
       ⇒ Socket f         -- ^ The socket
       → ByteString       -- ^ Message contents
       → SockFamilyAddr f -- ^ Message destination address
       → μ Int            -- ^ The number of bytes sent
sendTo s bs addr = sendTo' s bs noFlags addr

-- | Shut down a part of a full-duplex connection. See /shutdown(3)/.
shutdown ∷ MonadBase IO μ ⇒ Socket f → SockOps → μ ()
shutdown s dirs = withSocketFd s $ \fd →
    forM_ how $ throwErrnoIfMinus1_ "shutdown" . c_shutdown fd
  where how = if dirs .>=. sendSockOp then
                if dirs .>=. recvSockOp then
                  Just 2
{-# LINE 769 "src/System/Posix/Socket.hsc" #-}
                else
                  Just 1
{-# LINE 771 "src/System/Posix/Socket.hsc" #-}
              else
                if dirs .>=. recvSockOp then
                  Just 0
{-# LINE 774 "src/System/Posix/Socket.hsc" #-}
                else
                  Nothing

-- | Close the socket. See /close(3)/.
close ∷ MonadBase IO μ ⇒ Socket f → μ ()
close (Socket v) = liftBase $ modifyMVar_ v $ \fd → do
  when (fd >= 0) $ closeFdWith closeFd fd
  return (-1)

foreign import ccall "socket"
  c_socket ∷ CInt → CInt → SockProto → IO CInt
foreign import ccall "getsockopt"
  c_getsockopt ∷ Fd → CInt → CInt → Ptr α → Ptr Word32 → IO CInt
{-# LINE 787 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "setsockopt"
  c_setsockopt ∷ Fd → CInt → CInt → Ptr α → Word32 → IO CInt
{-# LINE 789 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "bind"
  c_bind ∷ Fd → Ptr α → Word32 → IO CInt
{-# LINE 791 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "connect"
  c_connect ∷ Fd → Ptr α → Word32 → IO CInt
{-# LINE 793 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "listen"
  c_listen ∷ Fd → CInt → IO CInt

{-# LINE 796 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "accept4"
  c_accept ∷ Fd → Ptr α → Ptr Word32 → CInt → IO CInt
{-# LINE 798 "src/System/Posix/Socket.hsc" #-}

{-# LINE 802 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "getsockname"
  c_getsockname ∷ Fd → Ptr α → Ptr Word32 → IO CInt
{-# LINE 804 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "getpeername"
  c_getpeername ∷ Fd → Ptr α → Ptr Word32 → IO CInt
{-# LINE 806 "src/System/Posix/Socket.hsc" #-}
foreign import ccall "sockatmark"
  c_sockatmark ∷ Fd → IO CInt
foreign import ccall "recvmsg"
  c_recvmsg ∷ Fd → Ptr β → MsgFlags → IO CSsize
foreign import ccall "sendmsg"
  c_sendmsg ∷ Fd → Ptr β → MsgFlags → IO CSsize
foreign import ccall "shutdown"
  c_shutdown ∷ Fd → CInt → IO CInt