{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms #-}
module Z.IO.Network.UDP (
UDP
, initUDP
, UDPConfig(..)
, defaultUDPConfig
, UVUDPFlag(UV_UDP_DEFAULT, UV_UDP_IPV6ONLY, UV_UDP_REUSEADDR)
, sendUDP
, UDPRecvConfig(..)
, defaultUDPRecvConfig
, recvUDPLoop
, recvUDP
, getSockName
, ConnectedUDP
, connectUDP
, disconnectUDP
, getPeerName
, sendConnectedUDP
, UVMembership(UV_JOIN_GROUP, UV_LEAVE_GROUP)
, setMembership
, setSourceMembership
, setMulticastLoop
, setMulticastTTL
, setMulticastInterface
, setBroadcast
, setTTL
) where
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Primitive (primitive_)
import Data.Primitive.PrimArray as A
import Data.IORef
import Data.Word
import Data.Int
import Data.Bits ((.&.))
import Foreign.Storable (peek, poke)
import Foreign.Ptr (plusPtr)
import Foreign.C
import GHC.Prim (touch#)
import Z.Data.Array as A
import Z.Data.Vector.Base as V
import Z.Data.Vector.Extra as V
import Z.Data.CBytes as CBytes
import Z.IO.Network.SocketAddr
import Z.Foreign
import Z.IO.UV.Errno (pattern UV_EMSGSIZE)
import Z.IO.UV.FFI
import Z.IO.UV.Manager
import Z.IO.Exception
import Z.IO.Resource
data UDP = UDP
{ UDP -> Ptr UVHandle
udpHandle :: {-# UNPACK #-} !(Ptr UVHandle)
, UDP -> UVSlot
udpSlot :: {-# UNPACK #-} !UVSlot
, UDP -> UVManager
udpManager :: UVManager
, UDP -> MutablePrimArray RealWorld Word8
udpSendBuffer :: {-# UNPACK #-} !(A.MutablePrimArray RealWorld Word8)
, UDP -> IORef Bool
udpClosed :: {-# UNPACK #-} !(IORef Bool)
}
instance Show UDP where
show :: UDP -> String
show (UDP Ptr UVHandle
hdl UVSlot
slot UVManager
uvm MutablePrimArray RealWorld Word8
_ IORef Bool
_) =
String
"UDP{udpHandle=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr UVHandle -> String
forall a. Show a => a -> String
show Ptr UVHandle
hdl String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
",udpSlot=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UVSlot -> String
forall a. Show a => a -> String
show UVSlot
slot String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
",udpManager=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UVManager -> String
forall a. Show a => a -> String
show UVManager
uvm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
data UDPConfig = UDPConfig
{ UDPConfig -> UVSlot
udpSendMsgSize :: {-# UNPACK #-} !Int
, UDPConfig -> Maybe (SocketAddr, UVUDPFlag)
udpLocalAddr :: Maybe (SocketAddr, UVUDPFlag)
} deriving (UVSlot -> UDPConfig -> ShowS
[UDPConfig] -> ShowS
UDPConfig -> String
(UVSlot -> UDPConfig -> ShowS)
-> (UDPConfig -> String)
-> ([UDPConfig] -> ShowS)
-> Show UDPConfig
forall a.
(UVSlot -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UDPConfig] -> ShowS
$cshowList :: [UDPConfig] -> ShowS
show :: UDPConfig -> String
$cshow :: UDPConfig -> String
showsPrec :: UVSlot -> UDPConfig -> ShowS
$cshowsPrec :: UVSlot -> UDPConfig -> ShowS
Show, UDPConfig -> UDPConfig -> Bool
(UDPConfig -> UDPConfig -> Bool)
-> (UDPConfig -> UDPConfig -> Bool) -> Eq UDPConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UDPConfig -> UDPConfig -> Bool
$c/= :: UDPConfig -> UDPConfig -> Bool
== :: UDPConfig -> UDPConfig -> Bool
$c== :: UDPConfig -> UDPConfig -> Bool
Eq, Eq UDPConfig
Eq UDPConfig
-> (UDPConfig -> UDPConfig -> Ordering)
-> (UDPConfig -> UDPConfig -> Bool)
-> (UDPConfig -> UDPConfig -> Bool)
-> (UDPConfig -> UDPConfig -> Bool)
-> (UDPConfig -> UDPConfig -> Bool)
-> (UDPConfig -> UDPConfig -> UDPConfig)
-> (UDPConfig -> UDPConfig -> UDPConfig)
-> Ord UDPConfig
UDPConfig -> UDPConfig -> Bool
UDPConfig -> UDPConfig -> Ordering
UDPConfig -> UDPConfig -> UDPConfig
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 :: UDPConfig -> UDPConfig -> UDPConfig
$cmin :: UDPConfig -> UDPConfig -> UDPConfig
max :: UDPConfig -> UDPConfig -> UDPConfig
$cmax :: UDPConfig -> UDPConfig -> UDPConfig
>= :: UDPConfig -> UDPConfig -> Bool
$c>= :: UDPConfig -> UDPConfig -> Bool
> :: UDPConfig -> UDPConfig -> Bool
$c> :: UDPConfig -> UDPConfig -> Bool
<= :: UDPConfig -> UDPConfig -> Bool
$c<= :: UDPConfig -> UDPConfig -> Bool
< :: UDPConfig -> UDPConfig -> Bool
$c< :: UDPConfig -> UDPConfig -> Bool
compare :: UDPConfig -> UDPConfig -> Ordering
$ccompare :: UDPConfig -> UDPConfig -> Ordering
$cp1Ord :: Eq UDPConfig
Ord)
defaultUDPConfig :: UDPConfig
defaultUDPConfig :: UDPConfig
defaultUDPConfig = UVSlot -> Maybe (SocketAddr, UVUDPFlag) -> UDPConfig
UDPConfig UVSlot
512 Maybe (SocketAddr, UVUDPFlag)
forall a. Maybe a
Nothing
initUDP :: HasCallStack
=> UDPConfig
-> Resource UDP
initUDP :: UDPConfig -> Resource UDP
initUDP (UDPConfig UVSlot
sbsiz Maybe (SocketAddr, UVUDPFlag)
maddr) = IO UDP -> (UDP -> IO ()) -> Resource UDP
forall a. IO a -> (a -> IO ()) -> Resource a
initResource
(do UVManager
uvm <- IO UVManager
getUVManager
(Ptr UVHandle
hdl, UVSlot
slot) <- UVManager
-> (Ptr UVLoop -> IO (Ptr UVHandle, UVSlot))
-> IO (Ptr UVHandle, UVSlot)
forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm ((Ptr UVLoop -> IO (Ptr UVHandle, UVSlot))
-> IO (Ptr UVHandle, UVSlot))
-> (Ptr UVLoop -> IO (Ptr UVHandle, UVSlot))
-> IO (Ptr UVHandle, UVSlot)
forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> do
Ptr UVHandle
hdl <- Ptr UVLoop -> IO (Ptr UVHandle)
hs_uv_handle_alloc Ptr UVLoop
loop
UVSlot
slot <- HasCallStack => UVManager -> IO UVSlotUnSafe -> IO UVSlot
UVManager -> IO UVSlotUnSafe -> IO UVSlot
getUVSlot UVManager
uvm (Ptr UVHandle -> IO UVSlotUnSafe
peekUVHandleData Ptr UVHandle
hdl)
Maybe UVSlot
_ <- MVar UVSlot -> IO (Maybe UVSlot)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar (MVar UVSlot -> IO (Maybe UVSlot))
-> IO (MVar UVSlot) -> IO (Maybe UVSlot)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UVManager -> UVSlot -> IO (MVar UVSlot)
getBlockMVar UVManager
uvm UVSlot
slot
(do IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_udp_init Ptr UVLoop
loop Ptr UVHandle
hdl)
) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` Ptr UVHandle -> IO ()
hs_uv_handle_free Ptr UVHandle
hdl
(Ptr UVHandle, UVSlot) -> IO (Ptr UVHandle, UVSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr UVHandle
hdl, UVSlot
slot)
Maybe (SocketAddr, UVUDPFlag)
-> ((SocketAddr, UVUDPFlag) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (SocketAddr, UVUDPFlag)
maddr (((SocketAddr, UVUDPFlag) -> IO ()) -> IO ())
-> ((SocketAddr, UVUDPFlag) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (SocketAddr
addr, UVUDPFlag
flag) ->
SocketAddr -> (MBA# SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
addr ((MBA# SocketAddr -> IO ()) -> IO ())
-> (MBA# SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
p ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> UVUDPFlag -> IO CInt
uv_udp_bind Ptr UVHandle
hdl MBA# SocketAddr
p UVUDPFlag
flag)
MutablePrimArray RealWorld Word8
sbuf <- UVSlot -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
UVSlot -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray (UVSlot -> UVSlot -> UVSlot
forall a. Ord a => a -> a -> a
max UVSlot
0 UVSlot
sbsiz)
IORef Bool
closed <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
UDP -> IO UDP
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr UVHandle
-> UVSlot
-> UVManager
-> MutablePrimArray RealWorld Word8
-> IORef Bool
-> UDP
UDP Ptr UVHandle
hdl UVSlot
slot UVManager
uvm MutablePrimArray RealWorld Word8
sbuf IORef Bool
closed))
(\ (UDP Ptr UVHandle
hdl UVSlot
_ UVManager
uvm MutablePrimArray RealWorld Word8
_ IORef Bool
closed) -> UVManager -> IO () -> IO ()
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
c <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
closed
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
c (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
closed Bool
True IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr UVHandle -> IO ()
hs_uv_handle_close Ptr UVHandle
hdl)
checkUDPClosed :: HasCallStack => UDP -> IO ()
checkUDPClosed :: UDP -> IO ()
checkUDPClosed UDP
udp = do
Bool
c <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (UDP -> IORef Bool
udpClosed UDP
udp)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c IO ()
forall a. HasCallStack => IO a
throwECLOSED
getSockName :: HasCallStack => UDP -> IO SocketAddr
getSockName :: UDP -> IO SocketAddr
getSockName udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
(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_udp_getsockname Ptr UVHandle
hdl MBA# SocketAddr
paddr MBA# SocketAddr
plen)
newtype ConnectedUDP = ConnectedUDP UDP deriving UVSlot -> ConnectedUDP -> ShowS
[ConnectedUDP] -> ShowS
ConnectedUDP -> String
(UVSlot -> ConnectedUDP -> ShowS)
-> (ConnectedUDP -> String)
-> ([ConnectedUDP] -> ShowS)
-> Show ConnectedUDP
forall a.
(UVSlot -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectedUDP] -> ShowS
$cshowList :: [ConnectedUDP] -> ShowS
show :: ConnectedUDP -> String
$cshow :: ConnectedUDP -> String
showsPrec :: UVSlot -> ConnectedUDP -> ShowS
$cshowsPrec :: UVSlot -> ConnectedUDP -> ShowS
Show
connectUDP :: HasCallStack => UDP -> SocketAddr -> IO ConnectedUDP
connectUDP :: UDP -> SocketAddr -> IO ConnectedUDP
connectUDP udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) SocketAddr
addr = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
SocketAddr -> (MBA# SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
addr ((MBA# SocketAddr -> IO ()) -> IO ())
-> (MBA# SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> MBA# SocketAddr -> IO CInt
uv_udp_connect Ptr UVHandle
hdl MBA# SocketAddr
paddr)
ConnectedUDP -> IO ConnectedUDP
forall (m :: * -> *) a. Monad m => a -> m a
return (UDP -> ConnectedUDP
ConnectedUDP UDP
udp)
disconnectUDP :: HasCallStack => ConnectedUDP -> IO UDP
disconnectUDP :: ConnectedUDP -> IO UDP
disconnectUDP (ConnectedUDP udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_)) = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> Ptr SocketAddr -> IO CInt
uv_udp_disconnect Ptr UVHandle
hdl Ptr SocketAddr
forall a. Ptr a
nullPtr)
UDP -> IO UDP
forall (m :: * -> *) a. Monad m => a -> m a
return UDP
udp
getPeerName :: HasCallStack => ConnectedUDP -> IO SocketAddr
getPeerName :: ConnectedUDP -> IO SocketAddr
getPeerName (ConnectedUDP udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_)) = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
(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_udp_getpeername Ptr UVHandle
hdl MBA# SocketAddr
paddr MBA# SocketAddr
plen)
sendConnectedUDP :: HasCallStack => ConnectedUDP -> V.Bytes -> IO ()
sendConnectedUDP :: ConnectedUDP -> Bytes -> IO ()
sendConnectedUDP (ConnectedUDP udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
uvm MutablePrimArray RealWorld Word8
sbuf IORef Bool
_)) (V.PrimVector PrimArray Word8
ba UVSlot
s UVSlot
la) = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
UVSlot
lb <- MutablePrimArray (PrimState IO) Word8 -> IO UVSlot
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m UVSlot
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
sbuf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UVSlot
la UVSlot -> UVSlot -> Bool
forall a. Ord a => a -> a -> Bool
> UVSlot
lb) (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
UV_EMSGSIZE))
MutablePrimArray (PrimState IO) Word8
-> UVSlot -> PrimArray Word8 -> UVSlot -> UVSlot -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> UVSlot -> PrimArray a -> UVSlot -> UVSlot -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
sbuf UVSlot
0 PrimArray Word8
ba UVSlot
s UVSlot
la
MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
sbuf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pbuf -> do
MVar UVSlot
m <- UVManager -> IO (MVar UVSlot) -> IO (MVar UVSlot)
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm (IO (MVar UVSlot) -> IO (MVar UVSlot))
-> IO (MVar UVSlot) -> IO (MVar UVSlot)
forall a b. (a -> b) -> a -> b
$ do
UVSlot
reqSlot <- HasCallStack => UVManager -> IO UVSlotUnSafe -> IO UVSlot
UVManager -> IO UVSlotUnSafe -> IO UVSlot
getUVSlot UVManager
uvm (Ptr UVHandle -> Ptr Word8 -> UVSlot -> IO UVSlotUnSafe
hs_uv_udp_send_connected Ptr UVHandle
hdl Ptr Word8
pbuf UVSlot
la)
MVar UVSlot
reqMVar <- UVManager -> UVSlot -> IO (MVar UVSlot)
getBlockMVar UVManager
uvm UVSlot
reqSlot
Maybe UVSlot
_ <- MVar UVSlot -> IO (Maybe UVSlot)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar UVSlot
reqMVar
MVar UVSlot -> IO (MVar UVSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return MVar UVSlot
reqMVar
IO UVSlot -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO UVSlot -> IO UVSlot
forall a. IO a -> IO a
uninterruptibleMask_ (IO UVSlot -> IO UVSlot) -> IO UVSlot -> IO UVSlot
forall a b. (a -> b) -> a -> b
$ MVar UVSlot -> IO UVSlot
forall a. MVar a -> IO a
takeMVar MVar UVSlot
m)
sendUDP :: HasCallStack => UDP -> SocketAddr -> V.Bytes -> IO ()
sendUDP :: UDP -> SocketAddr -> Bytes -> IO ()
sendUDP udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
uvm MutablePrimArray RealWorld Word8
sbuf IORef Bool
_) SocketAddr
addr (V.PrimVector PrimArray Word8
ba UVSlot
s UVSlot
la) = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
UVSlot
lb <- MutablePrimArray (PrimState IO) Word8 -> IO UVSlot
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m UVSlot
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
sbuf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UVSlot
la UVSlot -> UVSlot -> Bool
forall a. Ord a => a -> a -> Bool
> UVSlot
lb) (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
UV_EMSGSIZE))
MutablePrimArray (PrimState IO) Word8
-> UVSlot -> PrimArray Word8 -> UVSlot -> UVSlot -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> UVSlot -> PrimArray a -> UVSlot -> UVSlot -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
sbuf UVSlot
0 PrimArray Word8
ba UVSlot
s UVSlot
la
MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
sbuf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pbuf -> do
MVar UVSlot
m <- UVManager -> IO (MVar UVSlot) -> IO (MVar UVSlot)
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm (IO (MVar UVSlot) -> IO (MVar UVSlot))
-> IO (MVar UVSlot) -> IO (MVar UVSlot)
forall a b. (a -> b) -> a -> b
$ do
UVSlot
reqSlot <- SocketAddr -> (MBA# SocketAddr -> IO UVSlot) -> IO UVSlot
forall a. SocketAddr -> (MBA# SocketAddr -> IO a) -> IO a
withSocketAddrUnsafe SocketAddr
addr ((MBA# SocketAddr -> IO UVSlot) -> IO UVSlot)
-> (MBA# SocketAddr -> IO UVSlot) -> IO UVSlot
forall a b. (a -> b) -> a -> b
$ \ MBA# SocketAddr
paddr ->
HasCallStack => UVManager -> IO UVSlotUnSafe -> IO UVSlot
UVManager -> IO UVSlotUnSafe -> IO UVSlot
getUVSlot UVManager
uvm (Ptr UVHandle
-> MBA# SocketAddr -> Ptr Word8 -> UVSlot -> IO UVSlotUnSafe
hs_uv_udp_send Ptr UVHandle
hdl MBA# SocketAddr
paddr Ptr Word8
pbuf UVSlot
la)
MVar UVSlot
reqMVar <- UVManager -> UVSlot -> IO (MVar UVSlot)
getBlockMVar UVManager
uvm UVSlot
reqSlot
Maybe UVSlot
_ <- MVar UVSlot -> IO (Maybe UVSlot)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar UVSlot
reqMVar
MVar UVSlot -> IO (MVar UVSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return MVar UVSlot
reqMVar
IO UVSlot -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO UVSlot -> IO UVSlot
forall a. IO a -> IO a
uninterruptibleMask_ (IO UVSlot -> IO UVSlot) -> IO UVSlot -> IO UVSlot
forall a b. (a -> b) -> a -> b
$ MVar UVSlot -> IO UVSlot
forall a. MVar a -> IO a
takeMVar MVar UVSlot
m)
setMulticastLoop :: HasCallStack => UDP -> Bool -> IO ()
setMulticastLoop :: UDP -> Bool -> IO ()
setMulticastLoop udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) Bool
loop = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_udp_set_multicast_loop Ptr UVHandle
hdl (if Bool
loop then CInt
1 else CInt
0))
setMulticastTTL :: HasCallStack => UDP -> Int -> IO ()
setMulticastTTL :: UDP -> UVSlot -> IO ()
setMulticastTTL udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) UVSlot
ttl = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_udp_set_multicast_ttl Ptr UVHandle
hdl (UVSlot -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVSlot
ttl'))
where ttl' :: UVSlot
ttl' = UVSlot -> UVSlot -> UVSlot -> UVSlot
V.rangeCut UVSlot
ttl UVSlot
1 UVSlot
255
setMulticastInterface :: HasCallStack => UDP -> CBytes ->IO ()
setMulticastInterface :: UDP -> CBytes -> IO ()
setMulticastInterface udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) CBytes
iaddr = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
iaddr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
iaddrp ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CString -> IO CInt
uv_udp_set_multicast_interface Ptr UVHandle
hdl CString
iaddrp)
setBroadcast :: HasCallStack => UDP -> Bool -> IO ()
setBroadcast :: UDP -> Bool -> IO ()
setBroadcast udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) Bool
b = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_udp_set_broadcast Ptr UVHandle
hdl (if Bool
b then CInt
1 else CInt
0))
setTTL :: HasCallStack
=> UDP
-> Int
-> IO ()
setTTL :: UDP -> UVSlot -> IO ()
setTTL udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) UVSlot
ttl = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CInt -> IO CInt
uv_udp_set_ttl Ptr UVHandle
hdl (UVSlot -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UVSlot
ttl))
setMembership :: HasCallStack
=> UDP
-> CBytes
-> CBytes
-> UVMembership
-> IO ()
setMembership :: UDP -> CBytes -> CBytes -> UVMembership -> IO ()
setMembership udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) CBytes
gaddr CBytes
iaddr UVMembership
member = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
gaddr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
gaddrp ->
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
iaddr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
iaddrp ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> CString -> CString -> UVMembership -> IO CInt
uv_udp_set_membership Ptr UVHandle
hdl CString
gaddrp CString
iaddrp UVMembership
member)
setSourceMembership :: HasCallStack
=> UDP
-> CBytes
-> CBytes
-> CBytes
-> UVMembership
-> IO ()
setSourceMembership :: UDP -> CBytes -> CBytes -> CBytes -> UVMembership -> IO ()
setSourceMembership udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
_ UVManager
_ MutablePrimArray RealWorld Word8
_ IORef Bool
_) CBytes
gaddr CBytes
iaddr CBytes
source UVMembership
member = do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
gaddr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
gaddrp ->
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
iaddr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
iaddrp ->
CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
source ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
sourcep ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle
-> CString -> CString -> CString -> UVMembership -> IO CInt
uv_udp_set_source_membership Ptr UVHandle
hdl CString
gaddrp CString
iaddrp CString
sourcep UVMembership
member)
data UDPRecvConfig = UDPRecvConfig
{ UDPRecvConfig -> Int32
recvMsgSize :: {-# UNPACK #-} !Int32
, UDPRecvConfig -> UVSlot
recvBatchSize :: {-# UNPACK #-} !Int
}
defaultUDPRecvConfig :: UDPRecvConfig
defaultUDPRecvConfig :: UDPRecvConfig
defaultUDPRecvConfig = Int32 -> UVSlot -> UDPRecvConfig
UDPRecvConfig Int32
512 UVSlot
6
newRecvBuf :: Int32 -> Int -> IO (A.MutablePrimArray RealWorld Word8, A.MutablePrimArray RealWorld (Ptr Word8))
newRecvBuf :: Int32
-> UVSlot
-> IO
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
newRecvBuf Int32
bufSiz UVSlot
bufArrSiz = do
MutablePrimArray RealWorld Word8
rbuf <- UVSlot -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
UVSlot -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray (Int32 -> UVSlot
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
bufsiz' UVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
* UVSlot
bufArrSiz')
MutablePrimArray RealWorld (Ptr Word8)
rbufArr <- UVSlot -> IO (MutablePrimArray (PrimState IO) (Ptr Word8))
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
UVSlot -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray UVSlot
bufArrSiz'
MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p ->
[UVSlot] -> (UVSlot -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [UVSlot
0..UVSlot
bufArrSiz'UVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
-UVSlot
1] ((UVSlot -> IO ()) -> IO ()) -> (UVSlot -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVSlot
i -> do
let bufNPtr :: Ptr b
bufNPtr = Ptr Word8
p Ptr Word8 -> UVSlot -> Ptr b
forall a b. Ptr a -> UVSlot -> Ptr b
`plusPtr` (UVSlot
i UVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
* Int32 -> UVSlot
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
bufsiz')
MutablePrimArray (PrimState IO) (Ptr Word8)
-> UVSlot -> Ptr Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> UVSlot -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
rbufArr UVSlot
i Ptr Word8
forall a. Ptr a
bufNPtr
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> IO
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (MutablePrimArray RealWorld Word8
rbuf, MutablePrimArray RealWorld (Ptr Word8)
rbufArr)
where
bufsiz' :: Int32
bufsiz' = Int32
140 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
max Int32
0 Int32
bufSiz)
bufArrSiz' :: UVSlot
bufArrSiz' = UVSlot -> UVSlot -> UVSlot
forall a. Ord a => a -> a -> a
max UVSlot
1 UVSlot
bufArrSiz
recvUDPLoop :: HasCallStack
=> UDPRecvConfig
-> UDP
-> ((Maybe SocketAddr, Bool, V.Bytes) -> IO a)
-> IO ()
recvUDPLoop :: UDPRecvConfig
-> UDP -> ((Maybe SocketAddr, Bool, Bytes) -> IO a) -> IO ()
recvUDPLoop (UDPRecvConfig Int32
bufSiz UVSlot
bufArrSiz) UDP
udp (Maybe SocketAddr, Bool, Bytes) -> IO a
worker = do
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
buf <- Int32
-> UVSlot
-> IO
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
newRecvBuf Int32
bufSiz UVSlot
bufArrSiz
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
[(Maybe SocketAddr, Bool, Bytes)]
msgs <- HasCallStack =>
UDP
-> (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, Bytes)]
UDP
-> (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, Bytes)]
recvUDPWith UDP
udp (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
buf Int32
bufSiz
[(Maybe SocketAddr, Bool, Bytes)]
-> ((Maybe SocketAddr, Bool, Bytes) -> IO a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Maybe SocketAddr, Bool, Bytes)]
msgs (Maybe SocketAddr, Bool, Bytes) -> IO a
worker
recvUDP :: HasCallStack => UDPRecvConfig -> UDP -> IO [(Maybe SocketAddr, Bool, V.Bytes)]
recvUDP :: UDPRecvConfig -> UDP -> IO [(Maybe SocketAddr, Bool, Bytes)]
recvUDP (UDPRecvConfig Int32
bufSiz UVSlot
bufArrSiz) UDP
udp = do
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
buf <- Int32
-> UVSlot
-> IO
(MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
newRecvBuf Int32
bufSiz UVSlot
bufArrSiz
HasCallStack =>
UDP
-> (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, Bytes)]
UDP
-> (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, Bytes)]
recvUDPWith UDP
udp (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
buf Int32
bufSiz
recvUDPWith :: HasCallStack
=> UDP
-> (A.MutablePrimArray RealWorld Word8, A.MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, V.Bytes)]
recvUDPWith :: UDP
-> (MutablePrimArray RealWorld Word8,
MutablePrimArray RealWorld (Ptr Word8))
-> Int32
-> IO [(Maybe SocketAddr, Bool, Bytes)]
recvUDPWith udp :: UDP
udp@(UDP Ptr UVHandle
hdl UVSlot
slot UVManager
uvm MutablePrimArray RealWorld Word8
_ IORef Bool
_) ((MutablePrimArray MBA# SocketAddr
mba#), MutablePrimArray RealWorld (Ptr Word8)
rbufArr) Int32
bufSiz = IO [(Maybe SocketAddr, Bool, Bytes)]
-> IO [(Maybe SocketAddr, Bool, Bytes)]
forall a. IO a -> IO a
mask_ (IO [(Maybe SocketAddr, Bool, Bytes)]
-> IO [(Maybe SocketAddr, Bool, Bytes)])
-> IO [(Maybe SocketAddr, Bool, Bytes)]
-> IO [(Maybe SocketAddr, Bool, Bytes)]
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => UDP -> IO ()
UDP -> IO ()
checkUDPClosed UDP
udp
UVSlot
rbufArrSiz <- MutablePrimArray (PrimState IO) (Ptr Word8) -> IO UVSlot
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m UVSlot
getSizeofMutablePrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
rbufArr
[UVSlot] -> (UVSlot -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [UVSlot
0..UVSlot
rbufArrSizUVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
-UVSlot
1] ((UVSlot -> IO ()) -> IO ()) -> (UVSlot -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVSlot
i -> do
Ptr Word8
p <- MutablePrimArray (PrimState IO) (Ptr Word8)
-> UVSlot -> IO (Ptr Word8)
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> UVSlot -> m a
readPrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
rbufArr UVSlot
i
Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p :: Ptr Int32) Int32
bufSiz
MutablePrimArray RealWorld (Ptr Word8)
-> (Ptr (Ptr Word8) -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld (Ptr Word8)
rbufArr ((Ptr (Ptr Word8) -> IO ()) -> IO ())
-> (Ptr (Ptr Word8) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr Word8)
p ->
UVManager -> UVSlot -> Ptr Word8 -> UVSlot -> IO ()
pokeBufferTable UVManager
uvm UVSlot
slot (Ptr (Ptr Word8) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Word8)
p) UVSlot
rbufArrSiz
MVar UVSlot
m <- UVManager -> UVSlot -> IO (MVar UVSlot)
getBlockMVar UVManager
uvm UVSlot
slot
Maybe UVSlot
_ <- MVar UVSlot -> IO (Maybe UVSlot)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar UVSlot
m
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
$ UVManager -> IO CInt -> IO CInt
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm (Ptr UVHandle -> IO CInt
hs_uv_udp_recv_start Ptr UVHandle
hdl)
UVSlot
r <- MVar UVSlot -> IO UVSlot
forall a. MVar a -> IO a
takeMVar MVar UVSlot
m IO UVSlot -> IO () -> IO UVSlot
forall a b. IO a -> IO b -> IO a
`onException` (do
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
$ UVManager -> IO CInt -> IO CInt
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm (Ptr UVHandle -> IO CInt
uv_udp_recv_stop Ptr UVHandle
hdl)
IO (Maybe UVSlot) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MVar UVSlot -> IO (Maybe UVSlot)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar UVSlot
m))
if UVSlot
r UVSlot -> UVSlot -> Bool
forall a. Ord a => a -> a -> Bool
< UVSlot
rbufArrSiz
then [UVSlot]
-> (UVSlot -> IO (Maybe SocketAddr, Bool, Bytes))
-> IO [(Maybe SocketAddr, Bool, Bytes)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [UVSlot
rbufArrSizUVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
-UVSlot
1, UVSlot
rbufArrSizUVSlot -> UVSlot -> UVSlot
forall a. Num a => a -> a -> a
-UVSlot
2 .. UVSlot
r] ((UVSlot -> IO (Maybe SocketAddr, Bool, Bytes))
-> IO [(Maybe SocketAddr, Bool, Bytes)])
-> (UVSlot -> IO (Maybe SocketAddr, Bool, Bytes))
-> IO [(Maybe SocketAddr, Bool, Bytes)]
forall a b. (a -> b) -> a -> b
$ \ UVSlot
i -> do
Ptr Word8
p <- MutablePrimArray (PrimState IO) (Ptr Word8)
-> UVSlot -> IO (Ptr Word8)
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> UVSlot -> m a
readPrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
rbufArr UVSlot
i
UVSlot
result <- IO UVSlot -> IO UVSlot
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (Int32 -> UVSlot
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> UVSlot) -> IO Int32 -> IO UVSlot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 (Ptr Word8 -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p))
Int32
flag <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 (Ptr Any -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
p Ptr Word8 -> UVSlot -> Ptr Any
forall a b. Ptr a -> UVSlot -> Ptr b
`plusPtr` UVSlot
4))
Int32
addrFlag <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 (Ptr Any -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
p Ptr Word8 -> UVSlot -> Ptr Any
forall a b. Ptr a -> UVSlot -> Ptr b
`plusPtr` UVSlot
8))
!Maybe SocketAddr
addr <- if Int32
addrFlag Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
1
then SocketAddr -> Maybe SocketAddr
forall a. a -> Maybe a
Just (SocketAddr -> Maybe SocketAddr)
-> IO SocketAddr -> IO (Maybe SocketAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr SocketAddr -> IO SocketAddr
Ptr SocketAddr -> IO SocketAddr
peekSocketAddr (Ptr Any -> Ptr SocketAddr
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
p Ptr Word8 -> UVSlot -> Ptr Any
forall a b. Ptr a -> UVSlot -> Ptr b
`plusPtr` UVSlot
12))
else Maybe SocketAddr -> IO (Maybe SocketAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketAddr
forall a. Maybe a
Nothing
let !partial :: Bool
partial = Int32
flag Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. Int32
UV_UDP_PARTIAL Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
0
MutablePrimArray RealWorld Word8
mba <- UVSlot -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
UVSlot -> m (MutablePrimArray (PrimState m) a)
A.newPrimArray UVSlot
result
MutablePrimArray (PrimState IO) Word8
-> UVSlot -> Ptr Word8 -> UVSlot -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> UVSlot -> Ptr a -> UVSlot -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba UVSlot
0 (Ptr Word8
p Ptr Word8 -> UVSlot -> Ptr Word8
forall a b. Ptr a -> UVSlot -> Ptr b
`plusPtr` UVSlot
140) UVSlot
result
PrimArray Word8
ba <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
A.unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba
(State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MBA# SocketAddr -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MBA# SocketAddr
mba#)
(Maybe SocketAddr, Bool, Bytes)
-> IO (Maybe SocketAddr, Bool, Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SocketAddr
addr, Bool
partial, PrimArray Word8 -> UVSlot -> UVSlot -> Bytes
forall a. PrimArray a -> UVSlot -> UVSlot -> PrimVector a
V.PrimVector PrimArray Word8
ba UVSlot
0 UVSlot
result)
else [(Maybe SocketAddr, Bool, Bytes)]
-> IO [(Maybe SocketAddr, Bool, Bytes)]
forall (m :: * -> *) a. Monad m => a -> m a
return []