module Z.IO.Network.TCP (
TCPClientConfig(..)
, UVStream
, defaultTCPClientConfig
, initTCPClient
, getTCPSockName
, TCPServerConfig(..)
, defaultTCPServerConfig
, startTCPServer
, getTCPPeerName
, helloWorld
, echo
, startServerLoop
, setTCPNoDelay
, setTCPKeepAlive
, initTCPStream
) where
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Primitive.PrimArray
import Foreign.Ptr
import GHC.Generics
import Z.Data.Text.Print (Print)
import Z.Data.JSON (JSON)
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
data TCPClientConfig = TCPClientConfig
{ TCPClientConfig -> Maybe SocketAddr
tcpClientAddr :: Maybe SocketAddr
, TCPClientConfig -> SocketAddr
tcpRemoteAddr :: SocketAddr
, TCPClientConfig -> Bool
tcpClientNoDelay :: Bool
, TCPClientConfig -> CUInt
tcpClientKeepAlive :: CUInt
} deriving (TCPClientConfig -> TCPClientConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TCPClientConfig -> TCPClientConfig -> Bool
$c/= :: TCPClientConfig -> TCPClientConfig -> Bool
== :: TCPClientConfig -> TCPClientConfig -> Bool
$c== :: TCPClientConfig -> TCPClientConfig -> Bool
Eq, Eq TCPClientConfig
TCPClientConfig -> TCPClientConfig -> Bool
TCPClientConfig -> TCPClientConfig -> Ordering
TCPClientConfig -> TCPClientConfig -> TCPClientConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TCPClientConfig -> TCPClientConfig -> TCPClientConfig
$cmin :: TCPClientConfig -> TCPClientConfig -> TCPClientConfig
max :: TCPClientConfig -> TCPClientConfig -> TCPClientConfig
$cmax :: TCPClientConfig -> TCPClientConfig -> TCPClientConfig
>= :: TCPClientConfig -> TCPClientConfig -> Bool
$c>= :: TCPClientConfig -> TCPClientConfig -> Bool
> :: TCPClientConfig -> TCPClientConfig -> Bool
$c> :: TCPClientConfig -> TCPClientConfig -> Bool
<= :: TCPClientConfig -> TCPClientConfig -> Bool
$c<= :: TCPClientConfig -> TCPClientConfig -> Bool
< :: TCPClientConfig -> TCPClientConfig -> Bool
$c< :: TCPClientConfig -> TCPClientConfig -> Bool
compare :: TCPClientConfig -> TCPClientConfig -> Ordering
$ccompare :: TCPClientConfig -> TCPClientConfig -> Ordering
Ord, Int -> TCPClientConfig -> ShowS
[TCPClientConfig] -> ShowS
TCPClientConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCPClientConfig] -> ShowS
$cshowList :: [TCPClientConfig] -> ShowS
show :: TCPClientConfig -> String
$cshow :: TCPClientConfig -> String
showsPrec :: Int -> TCPClientConfig -> ShowS
$cshowsPrec :: Int -> TCPClientConfig -> ShowS
Show, forall x. Rep TCPClientConfig x -> TCPClientConfig
forall x. TCPClientConfig -> Rep TCPClientConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TCPClientConfig x -> TCPClientConfig
$cfrom :: forall x. TCPClientConfig -> Rep TCPClientConfig x
Generic)
deriving anyclass (Int -> TCPClientConfig -> Builder ()
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> TCPClientConfig -> Builder ()
$ctoUTF8BuilderP :: Int -> TCPClientConfig -> Builder ()
Print, Value -> Converter TCPClientConfig
TCPClientConfig -> Value
TCPClientConfig -> Builder ()
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: TCPClientConfig -> Builder ()
$cencodeJSON :: TCPClientConfig -> Builder ()
toValue :: TCPClientConfig -> Value
$ctoValue :: TCPClientConfig -> Value
fromValue :: Value -> Converter TCPClientConfig
$cfromValue :: Value -> Converter TCPClientConfig
JSON)
defaultTCPClientConfig :: TCPClientConfig
{-# INLINABLE defaultTCPClientConfig #-}
defaultTCPClientConfig :: TCPClientConfig
defaultTCPClientConfig = Maybe SocketAddr -> SocketAddr -> Bool -> CUInt -> TCPClientConfig
TCPClientConfig forall a. Maybe a
Nothing (IPv4 -> PortNumber -> SocketAddr
SocketAddrIPv4 IPv4
ipv4Loopback PortNumber
8888) Bool
True CUInt
30
initTCPClient :: HasCallStack => TCPClientConfig -> Resource UVStream
{-# INLINABLE initTCPClient #-}
initTCPClient :: HasCallStack => 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 <- 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe SocketAddr
tcpClientAddr forall a b. (a -> b) -> a -> b
$ \ SocketAddr
tcpClientAddr' ->
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpClientAddr' forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
localPtr ->
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)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tcpClientNoDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ forall a b. (a -> b) -> a -> b
$ Ptr UVHandle -> CInt -> IO CInt
uv_tcp_nodelay Ptr UVHandle
hdl CInt
1
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tcpClientKeepAlive forall a. Ord a => a -> a -> Bool
> CUInt
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ forall a b. (a -> b) -> a -> b
$
Ptr UVHandle -> CInt -> CUInt -> IO CInt
uv_tcp_keepalive Ptr UVHandle
hdl CInt
1 CUInt
tcpClientKeepAlive
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpRemoteAddr forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
targetPtr -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int
withUVRequest UVManager
uvm 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
forall (m :: * -> *) a. Monad m => a -> m a
return UVStream
client
data TCPServerConfig = TCPServerConfig
{ TCPServerConfig -> SocketAddr
tcpListenAddr :: SocketAddr
, TCPServerConfig -> Int
tcpListenBacklog :: Int
, TCPServerConfig -> Bool
tcpServerWorkerNoDelay :: Bool
, TCPServerConfig -> CUInt
tcpServerWorkerKeepAlive :: CUInt
} deriving (TCPServerConfig -> TCPServerConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TCPServerConfig -> TCPServerConfig -> Bool
$c/= :: TCPServerConfig -> TCPServerConfig -> Bool
== :: TCPServerConfig -> TCPServerConfig -> Bool
$c== :: TCPServerConfig -> TCPServerConfig -> Bool
Eq, Eq TCPServerConfig
TCPServerConfig -> TCPServerConfig -> Bool
TCPServerConfig -> TCPServerConfig -> Ordering
TCPServerConfig -> TCPServerConfig -> TCPServerConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TCPServerConfig -> TCPServerConfig -> TCPServerConfig
$cmin :: TCPServerConfig -> TCPServerConfig -> TCPServerConfig
max :: TCPServerConfig -> TCPServerConfig -> TCPServerConfig
$cmax :: TCPServerConfig -> TCPServerConfig -> TCPServerConfig
>= :: TCPServerConfig -> TCPServerConfig -> Bool
$c>= :: TCPServerConfig -> TCPServerConfig -> Bool
> :: TCPServerConfig -> TCPServerConfig -> Bool
$c> :: TCPServerConfig -> TCPServerConfig -> Bool
<= :: TCPServerConfig -> TCPServerConfig -> Bool
$c<= :: TCPServerConfig -> TCPServerConfig -> Bool
< :: TCPServerConfig -> TCPServerConfig -> Bool
$c< :: TCPServerConfig -> TCPServerConfig -> Bool
compare :: TCPServerConfig -> TCPServerConfig -> Ordering
$ccompare :: TCPServerConfig -> TCPServerConfig -> Ordering
Ord, Int -> TCPServerConfig -> ShowS
[TCPServerConfig] -> ShowS
TCPServerConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCPServerConfig] -> ShowS
$cshowList :: [TCPServerConfig] -> ShowS
show :: TCPServerConfig -> String
$cshow :: TCPServerConfig -> String
showsPrec :: Int -> TCPServerConfig -> ShowS
$cshowsPrec :: Int -> TCPServerConfig -> ShowS
Show, forall x. Rep TCPServerConfig x -> TCPServerConfig
forall x. TCPServerConfig -> Rep TCPServerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TCPServerConfig x -> TCPServerConfig
$cfrom :: forall x. TCPServerConfig -> Rep TCPServerConfig x
Generic)
deriving anyclass (Int -> TCPServerConfig -> Builder ()
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> TCPServerConfig -> Builder ()
$ctoUTF8BuilderP :: Int -> TCPServerConfig -> Builder ()
Print, Value -> Converter TCPServerConfig
TCPServerConfig -> Value
TCPServerConfig -> Builder ()
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: TCPServerConfig -> Builder ()
$cencodeJSON :: TCPServerConfig -> Builder ()
toValue :: TCPServerConfig -> Value
$ctoValue :: TCPServerConfig -> Value
fromValue :: Value -> Converter TCPServerConfig
$cfromValue :: Value -> Converter TCPServerConfig
JSON)
defaultTCPServerConfig :: TCPServerConfig
{-# INLINABLE defaultTCPServerConfig #-}
defaultTCPServerConfig :: TCPServerConfig
defaultTCPServerConfig = SocketAddr -> Int -> Bool -> CUInt -> TCPServerConfig
TCPServerConfig
(IPv4 -> PortNumber -> SocketAddr
SocketAddrIPv4 IPv4
ipv4Any PortNumber
8888)
Int
256
Bool
True
CUInt
30
startTCPServer :: HasCallStack
=> TCPServerConfig
-> (UVStream -> IO ())
-> IO ()
{-# INLINABLE startTCPServer #-}
startTCPServer :: HasCallStack => 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
..} = HasCallStack =>
Int
-> (UVManager -> Resource UVStream)
-> (Ptr UVHandle -> IO ())
-> (CInt -> (UVStream -> IO ()) -> IO ())
-> (UVStream -> IO ())
-> IO ()
startServerLoop
(forall a. Ord a => a -> a -> a
max Int
tcpListenBacklog Int
128)
UVManager -> Resource UVStream
initTCPStream
(\ Ptr UVHandle
serverHandle -> forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
tcpListenAddr forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
addrPtr -> do
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))
(\ CInt
fd UVStream -> IO ()
worker -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkBa forall a b. (a -> b) -> a -> b
$ do
UVManager
uvm <- IO UVManager
getUVManager
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
initUVStream (\ Ptr UVLoop
loop Ptr UVHandle
hdl -> do
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_tcp_init Ptr UVLoop
loop Ptr UVHandle
hdl)
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_tcp_open Ptr UVHandle
hdl CInt
fd)) UVManager
uvm) forall a b. (a -> b) -> a -> b
$ \ UVStream
uvs -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tcpServerWorkerNoDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ forall a b. (a -> b) -> a -> b
$
Ptr UVHandle -> CInt -> IO CInt
uv_tcp_nodelay (UVStream -> Ptr UVHandle
uvsHandle UVStream
uvs) CInt
1
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
tcpServerWorkerKeepAlive forall a. Ord a => a -> a -> Bool
> CUInt
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ 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 ()
worker UVStream
uvs)
startServerLoop :: HasCallStack
=> Int
-> (UVManager -> Resource UVStream)
-> (Ptr UVHandle -> IO ())
-> (FD -> (UVStream -> IO ()) -> IO ())
-> (UVStream -> IO ())
-> IO ()
{-# INLINABLE startServerLoop #-}
startServerLoop :: HasCallStack =>
Int
-> (UVManager -> Resource UVStream)
-> (Ptr UVHandle -> IO ())
-> (CInt -> (UVStream -> IO ()) -> IO ())
-> (UVStream -> IO ())
-> IO ()
startServerLoop Int
backLog UVManager -> Resource UVStream
initStream Ptr UVHandle -> IO ()
bind CInt -> (UVStream -> IO ()) -> IO ()
spawn UVStream -> IO ()
worker = do
UVManager
serverUVManager <- IO UVManager
getUVManager
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (UVManager -> Resource UVStream
initStream UVManager
serverUVManager) forall a b. (a -> b) -> a -> b
$ \ (UVStream Ptr UVHandle
serverHandle Int
serverSlot UVManager
_ IORef Bool
_) -> do
Ptr UVHandle -> IO ()
bind Ptr UVHandle
serverHandle
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(do Ptr UVHandle
check <- forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull forall a b. (a -> b) -> a -> b
$ IO (Ptr UVHandle)
hs_uv_check_alloc
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)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr UVHandle
check)
Ptr UVHandle -> IO ()
hs_uv_check_close forall a b. (a -> b) -> a -> b
$
\ Ptr UVHandle
check -> do
MutablePrimArray RealWorld CInt
acceptBuf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
backLog
let acceptBufPtr :: Ptr Word8
acceptBufPtr = forall a b. Ptr a -> Ptr b
castPtr (forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld CInt
acceptBuf :: Ptr FD)
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
serverUVManager forall a b. (a -> b) -> a -> b
$ do
UVManager -> Int -> Ptr Word8 -> Int -> IO ()
pokeBufferTable UVManager
serverUVManager Int
serverSlot Ptr Word8
acceptBufPtr (Int
backLogforall a. Num a => a -> a -> a
-Int
1)
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
hs_uv_listen Ptr UVHandle
serverHandle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
backLog))
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ 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
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Int
_ <- forall a. MVar a -> IO a
takeMVar MVar Int
m
forall a. IO a -> IO a
mask_forall a b. (a -> b) -> a -> b
$ do
PrimArray CInt
acceptBufCopy <- forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
serverUVManager forall a b. (a -> b) -> a -> b
$ do
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
backLogforall a. Num a => a -> a -> a
-Int
1)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
acceptCountDown forall a. Eq a => a -> a -> Bool
== -Int
1) (Ptr UVHandle -> IO ()
hs_uv_listen_resume Ptr UVHandle
serverHandle)
let acceptCount :: Int
acceptCount = Int
backLog forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
acceptCountDown
MutablePrimArray RealWorld CInt
acceptBuf' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
acceptCount
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld CInt
acceptBuf' Int
0 MutablePrimArray RealWorld CInt
acceptBuf (Int
acceptCountDownforall a. Num a => a -> a -> a
+Int
1) Int
acceptCount
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld CInt
acceptBuf'
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray CInt
acceptBufCopyforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
let fd :: CInt
fd = forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray CInt
acceptBufCopy Int
i
if CInt
fd forall a. Ord a => a -> a -> Bool
< CInt
0
then forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (forall (m :: * -> *) a. Monad m => a -> m a
return CInt
fd)
else CInt -> (UVStream -> IO ()) -> IO ()
spawn CInt
fd UVStream -> IO ()
worker
initTCPStream :: UVManager -> Resource UVStream
{-# INLINABLE initTCPStream #-}
initTCPStream :: UVManager -> Resource UVStream
initTCPStream = HasCallStack =>
(Ptr UVLoop -> Ptr UVHandle -> IO ())
-> UVManager -> Resource UVStream
initUVStream (\ Ptr UVLoop
loop Ptr UVHandle
hdl -> forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_tcp_init Ptr UVLoop
loop Ptr UVHandle
hdl))
setTCPNoDelay :: HasCallStack => UVStream -> Bool -> IO ()
{-# INLINABLE setTCPNoDelay #-}
setTCPNoDelay :: HasCallStack => UVStream -> Bool -> IO ()
setTCPNoDelay UVStream
uvs Bool
nodelay =
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))
setTCPKeepAlive :: HasCallStack => UVStream -> CUInt -> IO ()
{-# INLINABLE setTCPKeepAlive #-}
setTCPKeepAlive :: HasCallStack => UVStream -> CUInt -> IO ()
setTCPKeepAlive UVStream
uvs CUInt
delay
| CUInt
delay forall a. Ord a => a -> a -> Bool
> CUInt
0 = 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 = 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)
getTCPSockName :: HasCallStack => UVStream -> IO SocketAddr
{-# INLINABLE getTCPSockName #-}
getTCPSockName :: HasCallStack => UVStream -> IO SocketAddr
getTCPSockName UVStream
uvs = do
(MBA# SocketAddr -> IO ()) -> IO SocketAddr
withSocketAddrStorageUnsafe forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a b. Prim a => a -> (MBA# SocketAddr -> IO b) -> IO (a, b)
withPrimUnsafe (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sizeOfSocketAddrStorage :: CInt) forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
plen ->
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)
getTCPPeerName :: HasCallStack => UVStream -> IO SocketAddr
{-# INLINABLE getTCPPeerName #-}
getTCPPeerName :: HasCallStack => UVStream -> IO SocketAddr
getTCPPeerName UVStream
uvs = do
(MBA# SocketAddr -> IO ()) -> IO SocketAddr
withSocketAddrStorageUnsafe forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a b. Prim a => a -> (MBA# SocketAddr -> IO b) -> IO (a, b)
withPrimUnsafe (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sizeOfSocketAddrStorage :: CInt) forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
plen ->
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)