{-|
Module      : Z.IO.Network.TCP
Description : TCP servers and clients
Copyright   : (c) Dong Han, 2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides an API for creating TCP servers and clients.

-}

module Z.IO.Network.TCP (
  -- * TCP Client
    TCPClientConfig(..)
  , UVStream
  , defaultTCPClientConfig
  , initTCPClient
  , getTCPSockName
  -- * TCP Server
  , TCPServerConfig(..)
  , defaultTCPServerConfig
  , startTCPServer
  , getTCPPeerName
  -- * For test
  , helloWorld
  , echo
  -- * Internal helper
  , setTCPNoDelay
  , setTCPKeepAlive
  , initTCPStream
  ) where

import           Control.Concurrent.MVar
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Primitive.PrimArray
import           Foreign.Ptr
import           Z.IO.Exception
import           Z.IO.Network.SocketAddr
import           Z.IO.Resource
import           Z.IO.UV.FFI
import           Z.IO.UV.Manager
import           Z.IO.UV.UVStream
import           Z.Foreign
import           Data.Coerce

--------------------------------------------------------------------------------

-- | A TCP client configuration
--
data TCPClientConfig = TCPClientConfig
    { TCPClientConfig -> Maybe SocketAddr
tcpClientAddr :: Maybe SocketAddr -- ^ assign a local address, or let OS pick one
    , TCPClientConfig -> SocketAddr
tcpRemoteAddr :: SocketAddr       -- ^ remote target address
    , TCPClientConfig -> Bool
tcpClientNoDelay :: Bool          -- ^ if we want to use @TCP_NODELAY@
    , TCPClientConfig -> CUInt
tcpClientKeepAlive :: CUInt       -- ^ set keepalive delay for client socket, see 'setTCPKeepAlive'
    }

-- | Default config, connect to @localhost:8888@.
--
defaultTCPClientConfig :: TCPClientConfig
defaultTCPClientConfig :: TCPClientConfig
defaultTCPClientConfig = Maybe SocketAddr -> SocketAddr -> Bool -> CUInt -> TCPClientConfig
TCPClientConfig Maybe SocketAddr
forall a. Maybe a
Nothing (PortNumber -> InetAddr -> SocketAddr
SocketAddrInet PortNumber
8888 InetAddr
inetLoopback) Bool
True CUInt
30

-- | init a TCP client 'Resource', which open a new connect when used.
--
initTCPClient :: HasCallStack => TCPClientConfig -> Resource UVStream
initTCPClient :: TCPClientConfig -> Resource UVStream
initTCPClient TCPClientConfig{Bool
Maybe SocketAddr
CUInt
SocketAddr
tcpClientKeepAlive :: CUInt
tcpClientNoDelay :: Bool
tcpRemoteAddr :: SocketAddr
tcpClientAddr :: Maybe SocketAddr
tcpClientKeepAlive :: TCPClientConfig -> CUInt
tcpClientNoDelay :: TCPClientConfig -> Bool
tcpRemoteAddr :: TCPClientConfig -> SocketAddr
tcpClientAddr :: TCPClientConfig -> Maybe SocketAddr
..} = do
    UVManager
uvm <- IO UVManager -> Resource UVManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UVManager
getUVManager
    UVStream
client <- UVManager -> Resource UVStream
initTCPStream UVManager
uvm
    let hdl :: Ptr UVHandle
hdl = UVStream -> Ptr UVHandle
uvsHandle UVStream
client
    IO () -> Resource ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Resource ()) -> IO () -> Resource ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe SocketAddr -> (SocketAddr -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe SocketAddr
tcpClientAddr ((SocketAddr -> IO ()) -> IO ()) -> (SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ SocketAddr
tcpClientAddr' ->
            SocketAddr -> (MBA# SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpClientAddr' ((MBA# SocketAddr -> IO ()) -> IO ())
-> (MBA# SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
localPtr ->
                -- bind is safe without withUVManager
                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> CUInt -> IO CInt
uv_tcp_bind Ptr UVHandle
hdl MBA# SocketAddr
localPtr CUInt
0)
        -- nodelay is safe without withUVManager
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tcpClientNoDelay (IO () -> IO ()) -> (IO CInt -> IO ()) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr UVHandle -> CInt -> IO CInt
uv_tcp_nodelay Ptr UVHandle
hdl CInt
1
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tcpClientKeepAlive CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0) (IO () -> IO ()) -> (IO CInt -> IO ()) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr UVHandle -> CInt -> CUInt -> IO CInt
uv_tcp_keepalive Ptr UVHandle
hdl CInt
1 CUInt
tcpClientKeepAlive
        SocketAddr -> (MBA# SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpRemoteAddr ((MBA# SocketAddr -> IO ()) -> IO ())
-> (MBA# SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
targetPtr -> do
            IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ())
-> ((Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int)
-> (Ptr UVLoop -> IO UVSlotUnsafe)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
withUVRequest UVManager
uvm ((Ptr UVLoop -> IO UVSlotUnsafe) -> IO ())
-> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
_ -> Ptr UVHandle -> MBA# SocketAddr -> IO UVSlotUnsafe
hs_uv_tcp_connect Ptr UVHandle
hdl MBA# SocketAddr
targetPtr
    UVStream -> Resource UVStream
forall (m :: * -> *) a. Monad m => a -> m a
return UVStream
client

--------------------------------------------------------------------------------

-- | A TCP server configuration
--
data TCPServerConfig = TCPServerConfig
    { TCPServerConfig -> SocketAddr
tcpListenAddr       :: SocketAddr      -- ^ listening address
    , TCPServerConfig -> Int
tcpListenBacklog    :: Int           -- ^ listening socket's backlog size, should be large enough(>128)
    , TCPServerConfig -> Bool
tcpServerWorkerNoDelay :: Bool       -- ^ if we want to use @TCP_NODELAY@
    , TCPServerConfig -> CUInt
tcpServerWorkerKeepAlive :: CUInt    -- ^ set keepalive delay for worker socket, see 'setTCPKeepAlive'
    }

-- | A default hello world server on localhost:8888
--
-- Test it with @main = startTCPServer defaultTCPServerConfig helloWorldWorker@ or
-- @main = startTCPServer defaultTCPServerConfig echoWorker@, now try @nc -v 127.0.0.1 8888@
--
defaultTCPServerConfig :: TCPServerConfig
defaultTCPServerConfig :: TCPServerConfig
defaultTCPServerConfig = SocketAddr -> Int -> Bool -> CUInt -> TCPServerConfig
TCPServerConfig
    (PortNumber -> InetAddr -> SocketAddr
SocketAddrInet PortNumber
8888 InetAddr
inetAny)
    Int
128
    Bool
True
    CUInt
30

-- | Start a server
--
-- Fork new worker thread upon a new connection.
--
startTCPServer :: HasCallStack
               => TCPServerConfig
               -> (UVStream -> IO ())   -- ^ worker which will get an accepted TCP stream and
                                        -- run in a seperated haskell thread,
                                        -- will be closed upon exception or worker finishes.
               -> IO ()
startTCPServer :: TCPServerConfig -> (UVStream -> IO ()) -> IO ()
startTCPServer TCPServerConfig{Bool
Int
CUInt
SocketAddr
tcpServerWorkerKeepAlive :: CUInt
tcpServerWorkerNoDelay :: Bool
tcpListenBacklog :: Int
tcpListenAddr :: SocketAddr
tcpServerWorkerKeepAlive :: TCPServerConfig -> CUInt
tcpServerWorkerNoDelay :: TCPServerConfig -> Bool
tcpListenBacklog :: TCPServerConfig -> Int
tcpListenAddr :: TCPServerConfig -> SocketAddr
..} UVStream -> IO ()
tcpServerWorker = do
    let backLog :: Int
backLog = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
tcpListenBacklog Int
128
    UVManager
serverUVManager <- IO UVManager
getUVManager
    Resource UVStream -> (UVStream -> IO ()) -> IO ()
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (UVManager -> Resource UVStream
initTCPStream UVManager
serverUVManager) ((UVStream -> IO ()) -> IO ()) -> (UVStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (UVStream Ptr UVHandle
serverHandle Int
serverSlot UVManager
_ IORef Bool
_) -> do
        -- bind is safe without withUVManager
        SocketAddr -> (MBA# SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpListenAddr ((MBA# SocketAddr -> IO ()) -> IO ())
-> (MBA# SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
addrPtr -> do
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> CUInt -> IO CInt
uv_tcp_bind Ptr UVHandle
serverHandle MBA# SocketAddr
addrPtr CUInt
0)
        IO (Ptr UVHandle)
-> (Ptr UVHandle -> IO ()) -> (Ptr UVHandle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
            (do Ptr UVHandle
check <- IO (Ptr UVHandle) -> IO (Ptr UVHandle)
forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull (IO (Ptr UVHandle) -> IO (Ptr UVHandle))
-> IO (Ptr UVHandle) -> IO (Ptr UVHandle)
forall a b. (a -> b) -> a -> b
$ IO (Ptr UVHandle)
hs_uv_check_alloc
                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> Ptr UVHandle -> IO CInt
hs_uv_check_init Ptr UVHandle
check Ptr UVHandle
serverHandle)
                Ptr UVHandle -> IO (Ptr UVHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr UVHandle
check)
            Ptr UVHandle -> IO ()
hs_uv_check_close ((Ptr UVHandle -> IO ()) -> IO ())
-> (Ptr UVHandle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \ Ptr UVHandle
check -> do
-- The buffer passing of accept is a litte complicated here, to get maximum performance,
-- we do batch accepting. i.e. recv multiple client inside libuv's event loop:
--
-- we poke uvmanager's buffer table as a Ptr Word8, with byte size (backLog*sizeof(FD))
-- inside libuv event loop, we cast the buffer back to int32_t* pointer.
-- each accept callback push a new socket fd to the buffer, and increase a counter(buffer_size_table).
-- backLog should be large enough(>128), so under windows we can't possibly filled it up within one
-- uv_run, under unix we hacked uv internal to provide a stop and resume function, when backLog is
-- reached, we will stop receiving.
--
-- once back to haskell side, we read all accepted sockets and fork worker threads.
-- if backLog is reached, we resume receiving from haskell side.
--
-- Step 1.
-- we allocate a buffer to hold accepted FDs, pass it just like a normal reading buffer.
-- then we can start listening.
                MutablePrimArray RealWorld CInt
acceptBuf <- Int -> IO (MutablePrimArray (PrimState IO) CInt)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
backLog
                -- https://stackoverflow.com/questions/1953639/is-it-safe-to-cast-socket-to-int-under-win64
                -- FD is 32bit CInt, it's large enough to hold uv_os_sock_t
                let acceptBufPtr :: Ptr Word8
acceptBufPtr = Ptr CInt -> Ptr Word8
coerce (MutablePrimArray RealWorld CInt -> Ptr CInt
forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld CInt
acceptBuf :: Ptr FD)

                UVManager -> IO () -> IO ()
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
serverUVManager (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    -- We use buffersize as accepted fd count(count backwards)
                    UVManager -> Int -> Ptr Word8 -> Int -> IO ()
pokeBufferTable UVManager
serverUVManager Int
serverSlot Ptr Word8
acceptBufPtr (Int
backLogInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
hs_uv_listen Ptr UVHandle
serverHandle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
backLog))
-- Step 2.
-- we start a uv_check_t for given uv_stream_t, with predefined checking callback
-- see hs_accept_check_cb in hs_uv_stream.c
                    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr UVHandle -> IO CInt
hs_uv_accept_check_start Ptr UVHandle
check

                MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
serverUVManager Int
serverSlot
                IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    -- wait until accept some FDs
                    Int
_ <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
m
-- Step 3.
-- After uv loop finishes, if we got some FDs, copy the FD buffer, fetch accepted FDs and fork worker threads.

                    -- we lock uv manager here in case of next uv_run overwrite current accept buffer
                    PrimArray CInt
acceptBufCopy <- UVManager -> IO (PrimArray CInt) -> IO (PrimArray CInt)
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
serverUVManager (IO (PrimArray CInt) -> IO (PrimArray CInt))
-> IO (PrimArray CInt) -> IO (PrimArray CInt)
forall a b. (a -> b) -> a -> b
$ do
                        Maybe Int
_ <- MVar Int -> IO (Maybe Int)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
                        Int
acceptCountDown <- UVManager -> Int -> IO Int
peekBufferSizeTable UVManager
serverUVManager Int
serverSlot
                        UVManager -> Int -> Int -> IO ()
pokeBufferSizeTable UVManager
serverUVManager Int
serverSlot (Int
backLogInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

                        -- if acceptCountDown count to -1, we should resume on haskell side
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
acceptCountDown Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1) (Ptr UVHandle -> IO ()
hs_uv_listen_resume Ptr UVHandle
serverHandle)

                        -- copy accepted FDs
                        let acceptCount :: Int
acceptCount = Int
backLog Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
acceptCountDown
                        MutablePrimArray RealWorld CInt
acceptBuf' <- Int -> IO (MutablePrimArray (PrimState IO) CInt)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
acceptCount
                        MutablePrimArray (PrimState IO) CInt
-> Int
-> MutablePrimArray (PrimState IO) CInt
-> Int
-> Int
-> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld CInt
MutablePrimArray (PrimState IO) CInt
acceptBuf' Int
0 MutablePrimArray RealWorld CInt
MutablePrimArray (PrimState IO) CInt
acceptBuf (Int
acceptCountDownInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
acceptCount
                        MutablePrimArray (PrimState IO) CInt -> IO (PrimArray CInt)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld CInt
MutablePrimArray (PrimState IO) CInt
acceptBuf'

                    -- fork worker thread
                    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..PrimArray CInt -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray CInt
acceptBufCopyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
                        let fd :: CInt
fd = PrimArray CInt -> Int -> CInt
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray CInt
acceptBufCopy Int
i
                        if CInt
fd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
                        -- minus fd indicate a server error and we should close server
                        then IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
fd)
                        -- It's important to use the worker thread's mananger instead of server's one!
                        else IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkBa (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            UVManager
uvm <- IO UVManager
getUVManager
                            Resource UVStream -> (UVStream -> IO ()) -> IO ()
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (HasCallStack =>
(Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager -> Resource UVStream
(Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager -> Resource UVStream
initUVStream (\ Ptr UVLoop
loop Ptr UVHandle
hdl -> do
                                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_tcp_init Ptr UVLoop
loop Ptr UVHandle
hdl)
                                IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
hs_uv_tcp_open Ptr UVHandle
hdl CInt
fd)) UVManager
uvm) ((UVStream -> IO ()) -> IO ()) -> (UVStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVStream
uvs -> do
                                -- safe without withUVManager
                                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tcpServerWorkerNoDelay (IO () -> IO ()) -> (IO CInt -> IO ()) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                                    Ptr UVHandle -> CInt -> IO CInt
uv_tcp_nodelay (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) CInt
1
                                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tcpServerWorkerKeepAlive CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0) (IO () -> IO ()) -> (IO CInt -> IO ()) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                                    Ptr UVHandle -> CInt -> CUInt -> IO CInt
uv_tcp_keepalive (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) CInt
1 CUInt
tcpServerWorkerKeepAlive
                                UVStream -> IO ()
tcpServerWorker UVStream
uvs

--------------------------------------------------------------------------------

initTCPStream :: UVManager -> Resource UVStream
initTCPStream :: UVManager -> Resource UVStream
initTCPStream = HasCallStack =>
(Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager -> Resource UVStream
(Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager -> Resource UVStream
initUVStream (\ Ptr UVLoop
loop Ptr UVHandle
hdl -> IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_tcp_init Ptr UVLoop
loop Ptr UVHandle
hdl))

-- | Enable or disable @TCP_NODELAY@, which enable or disable Nagle’s algorithm.
setTCPNoDelay :: HasCallStack => UVStream -> Bool -> IO ()
setTCPNoDelay :: UVStream -> Bool -> IO ()
setTCPNoDelay UVStream
uvs Bool
nodelay =
    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_tcp_nodelay (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) (if Bool
nodelay then CInt
1 else CInt
0))

-- | Enable \/ disable TCP keep-alive. delay is the initial delay in seconds, ignored when enable is zero.
--
-- After delay has been reached, 10 successive probes, each spaced 1 second from the previous one,
-- will still happen. If the connection is still lost at the end of this procedure,
-- then the connection is closed, pending io thread will throw 'TimeExpired' exception.
setTCPKeepAlive :: HasCallStack => UVStream -> CUInt -> IO ()
setTCPKeepAlive :: UVStream -> CUInt -> IO ()
setTCPKeepAlive UVStream
uvs CUInt
delay
    | CUInt
delay CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0 = IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> CUInt -> IO CInt
uv_tcp_keepalive (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) CInt
1 CUInt
delay)
    | Bool
otherwise = IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> CUInt -> IO CInt
uv_tcp_keepalive (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) CInt
0 CUInt
0)

-- | Get the current address to which the handle is bound.
getTCPSockName :: HasCallStack => UVStream -> IO SocketAddr
getTCPSockName :: UVStream -> IO SocketAddr
getTCPSockName UVStream
uvs = do
    (MBA# SocketAddr -> IO ()) -> IO SocketAddr
withSocketAddrStorageUnsafe ((MBA# SocketAddr -> IO ()) -> IO SocketAddr)
-> (MBA# SocketAddr -> IO ()) -> IO SocketAddr
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
        IO (CInt, ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (CInt, ()) -> IO ()) -> IO (CInt, ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> (MBA# SocketAddr -> IO ()) -> IO (CInt, ())
forall a b. Prim a => a -> (MBA# SocketAddr -> IO b) -> IO (a, b)
withPrimUnsafe (CSize -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sizeOfSocketAddrStorage :: CInt) ((MBA# SocketAddr -> IO ()) -> IO (CInt, ()))
-> (MBA# SocketAddr -> IO ()) -> IO (CInt, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
plen ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> MBA# SocketAddr -> IO CInt
uv_tcp_getsockname (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) MBA# SocketAddr
paddr MBA# SocketAddr
plen)

-- | Get the address of the peer connected to the handle.
getTCPPeerName :: HasCallStack => UVStream -> IO SocketAddr
getTCPPeerName :: UVStream -> IO SocketAddr
getTCPPeerName UVStream
uvs = do
    (MBA# SocketAddr -> IO ()) -> IO SocketAddr
withSocketAddrStorageUnsafe ((MBA# SocketAddr -> IO ()) -> IO SocketAddr)
-> (MBA# SocketAddr -> IO ()) -> IO SocketAddr
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
        IO (CInt, ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (CInt, ()) -> IO ()) -> IO (CInt, ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> (MBA# SocketAddr -> IO ()) -> IO (CInt, ())
forall a b. Prim a => a -> (MBA# SocketAddr -> IO b) -> IO (a, b)
withPrimUnsafe (CSize -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sizeOfSocketAddrStorage :: CInt) ((MBA# SocketAddr -> IO ()) -> IO (CInt, ()))
-> (MBA# SocketAddr -> IO ()) -> IO (CInt, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
plen ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> MBA# SocketAddr -> IO CInt
uv_tcp_getpeername (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) MBA# SocketAddr
paddr MBA# SocketAddr
plen)