{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Best current practice library for UDP clients and servers.
--
--   * Efficient receiving function without memory copy
--   * Proper buffer size
--   * Type-safe APIs
--   * TCP-like APIs (creating a UDP connection from a listing socket) in the server side
--   * Auto migration (network interface selection) in the client side
--
--   The 'Network.Socket.ByteString.recv' family in
--   "Network.Socket.ByteString" uses 'createAndTrim'
--   internaly.  So, one buffer is allocated before corresponding
--   system calls are called. Then another buffer is allocated
--   according to the input size and the input is copied.
--   Receiving functions provided by this library uses 'createUptoN'
--   to avoid the memory copy.
--
--   Recent application protocols are designed to avoid IP
--   fragmentation. So, the UDP payload size is never over 1,500.
--   This library uses 2,048 for the buffer size. This size ensures
--   no global locking when allocating 'ByteString' (i.e. a buffer).
--
--   To know the background of TCP-like API in the server side, see:
--
--   * https://kazu-yamamoto.hatenablog.jp/entry/2022/02/25/153122
--
--   To know the background of auto migration in the client side, see:
--
--   * https://kazu-yamamoto.hatenablog.jp/entry/2021/06/29/134930
--   * https://www.iij.ad.jp/en/dev/iir/pdf/iir_vol52_focus2_EN.pdf (Sec 3.9)
module Network.UDP (
  -- * Sockets used by clients and servers after accept
    UDPSocket(..)
  , clientSocket
  , recv
  , recvBuf
  , send
  , sendBuf
  -- * Server's wildcard socket
  , ListenSocket(..)
  , serverSocket
  , ClientSockAddr(..)
  , recvFrom
  , sendTo
  -- * Server's connected socket
  , accept
  -- * Closing
  , stop
  , close
  -- * Misc
  , natRebinding
  ) where

import Control.Concurrent
import qualified Control.Exception as E
import Control.Monad
import Data.ByteString (ByteString)
import Data.IP hiding (addr)
import Data.Maybe (fromJust)
import Data.Word (Word8)
import Foreign.Ptr (Ptr)
import qualified GHC.IO.Exception as E
import qualified Network.Socket as NS
import Network.Socket hiding (accept, close, sendBuf, recvBuf)
import qualified Network.Socket.ByteString as NSB
import qualified System.IO.Error as E

import Network.UDP.Types
import qualified Network.UDP.Recv as R

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

anySockAddr :: SockAddr -> SockAddr
anySockAddr :: SockAddr -> SockAddr
anySockAddr (SockAddrInet PortNumber
p HostAddress
_)      = PortNumber -> HostAddress -> SockAddr
SockAddrInet  PortNumber
p HostAddress
0
anySockAddr (SockAddrInet6 PortNumber
p HostAddress
f HostAddress6
_ HostAddress
s) = PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
SockAddrInet6 PortNumber
p HostAddress
f (HostAddress
0,HostAddress
0,HostAddress
0,HostAddress
0) HostAddress
s
anySockAddr SockAddr
_                       = [Char] -> SockAddr
forall a. HasCallStack => [Char] -> a
error [Char]
"anySockAddr"

isAnySockAddr :: SockAddr -> Bool
isAnySockAddr :: SockAddr -> Bool
isAnySockAddr (SockAddrInet PortNumber
_ HostAddress
0)              = Bool
True
isAnySockAddr (SockAddrInet6 PortNumber
_ HostAddress
_ (HostAddress
0,HostAddress
0,HostAddress
0,HostAddress
0) HostAddress
_) = Bool
True
isAnySockAddr SockAddr
_                               = Bool
False

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

-- | A listening socket for UDP which can be used
--   for 'recvFrom' and 'sendTo'.
--   Optionally, a connected UDP socket can be created
--   with 'accept' as an emulation of TCP.
data ListenSocket = ListenSocket {
    ListenSocket -> Socket
listenSocket :: Socket
  , ListenSocket -> SockAddr
mySockAddr   :: SockAddr
  , ListenSocket -> Bool
wildcard     :: Bool -- ^ 'True' for wildcard. 'False' for interface-specific.
  } deriving (ListenSocket -> ListenSocket -> Bool
(ListenSocket -> ListenSocket -> Bool)
-> (ListenSocket -> ListenSocket -> Bool) -> Eq ListenSocket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListenSocket -> ListenSocket -> Bool
== :: ListenSocket -> ListenSocket -> Bool
$c/= :: ListenSocket -> ListenSocket -> Bool
/= :: ListenSocket -> ListenSocket -> Bool
Eq, Int -> ListenSocket -> ShowS
[ListenSocket] -> ShowS
ListenSocket -> [Char]
(Int -> ListenSocket -> ShowS)
-> (ListenSocket -> [Char])
-> ([ListenSocket] -> ShowS)
-> Show ListenSocket
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListenSocket -> ShowS
showsPrec :: Int -> ListenSocket -> ShowS
$cshow :: ListenSocket -> [Char]
show :: ListenSocket -> [Char]
$cshowList :: [ListenSocket] -> ShowS
showList :: [ListenSocket] -> ShowS
Show)

-- | A UDP socket which are used with 'recv' and 'send'.
data UDPSocket = UDPSocket {
    UDPSocket -> Socket
udpSocket    :: Socket
  , UDPSocket -> SockAddr
peerSockAddr :: SockAddr -- ^ Used for a unconnected socket naturally. Used for a connected sockdet for checking
  , UDPSocket -> Bool
connected    :: Bool
  } deriving (UDPSocket -> UDPSocket -> Bool
(UDPSocket -> UDPSocket -> Bool)
-> (UDPSocket -> UDPSocket -> Bool) -> Eq UDPSocket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UDPSocket -> UDPSocket -> Bool
== :: UDPSocket -> UDPSocket -> Bool
$c/= :: UDPSocket -> UDPSocket -> Bool
/= :: UDPSocket -> UDPSocket -> Bool
Eq, Int -> UDPSocket -> ShowS
[UDPSocket] -> ShowS
UDPSocket -> [Char]
(Int -> UDPSocket -> ShowS)
-> (UDPSocket -> [Char])
-> ([UDPSocket] -> ShowS)
-> Show UDPSocket
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UDPSocket -> ShowS
showsPrec :: Int -> UDPSocket -> ShowS
$cshow :: UDPSocket -> [Char]
show :: UDPSocket -> [Char]
$cshowList :: [UDPSocket] -> ShowS
showList :: [UDPSocket] -> ShowS
Show)

-- | A client socket address from the server point of view.
data ClientSockAddr = ClientSockAddr SockAddr [Cmsg] deriving (ClientSockAddr -> ClientSockAddr -> Bool
(ClientSockAddr -> ClientSockAddr -> Bool)
-> (ClientSockAddr -> ClientSockAddr -> Bool) -> Eq ClientSockAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientSockAddr -> ClientSockAddr -> Bool
== :: ClientSockAddr -> ClientSockAddr -> Bool
$c/= :: ClientSockAddr -> ClientSockAddr -> Bool
/= :: ClientSockAddr -> ClientSockAddr -> Bool
Eq, Int -> ClientSockAddr -> ShowS
[ClientSockAddr] -> ShowS
ClientSockAddr -> [Char]
(Int -> ClientSockAddr -> ShowS)
-> (ClientSockAddr -> [Char])
-> ([ClientSockAddr] -> ShowS)
-> Show ClientSockAddr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientSockAddr -> ShowS
showsPrec :: Int -> ClientSockAddr -> ShowS
$cshow :: ClientSockAddr -> [Char]
show :: ClientSockAddr -> [Char]
$cshowList :: [ClientSockAddr] -> ShowS
showList :: [ClientSockAddr] -> ShowS
Show)

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

-- | Creating a listening UDP socket.
serverSocket :: (IP, PortNumber) -> IO ListenSocket
serverSocket :: (IP, PortNumber) -> IO ListenSocket
serverSocket (IP, PortNumber)
ip = IO Socket
-> (Socket -> IO ())
-> (Socket -> IO ListenSocket)
-> IO ListenSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError IO Socket
open Socket -> IO ()
NS.close ((Socket -> IO ListenSocket) -> IO ListenSocket)
-> (Socket -> IO ListenSocket) -> IO ListenSocket
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
    Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
s SocketOption
ReuseAddr Int
1
    Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s CInt -> IO ()
setCloseOnExecIfNeeded
#if !defined(openbsd_HOST_OS)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Family
family Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
AF_INET6) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
s SocketOption
IPv6Only Int
1
#endif
    Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
sa
    let wild :: Bool
wild = SockAddr -> Bool
isAnySockAddr SockAddr
sa
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wild (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let opt :: SocketOption
opt = SockAddr -> SocketOption
decideOption SockAddr
sa
        Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
s SocketOption
opt Int
1
    ListenSocket -> IO ListenSocket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListenSocket -> IO ListenSocket)
-> ListenSocket -> IO ListenSocket
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> Bool -> ListenSocket
ListenSocket Socket
s SockAddr
sa Bool
wild
  where
    sa :: SockAddr
sa     = (IP, PortNumber) -> SockAddr
toSockAddr (IP, PortNumber)
ip
    family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
sa
    open :: IO Socket
open   = Family -> SocketType -> CInt -> IO Socket
socket Family
family SocketType
Datagram CInt
defaultProtocol

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

-- | Receiving data with a listening UDP socket.
--   For a wildcard socket, recvmsg() is called.
--   For an interface specific socket, recvfrom() is called.
recvFrom :: ListenSocket -> IO (ByteString, ClientSockAddr)
recvFrom :: ListenSocket -> IO (ByteString, ClientSockAddr)
recvFrom ListenSocket{Bool
SockAddr
Socket
listenSocket :: ListenSocket -> Socket
mySockAddr :: ListenSocket -> SockAddr
wildcard :: ListenSocket -> Bool
listenSocket :: Socket
mySockAddr :: SockAddr
wildcard :: Bool
..}
  | Bool
wildcard = do
        (ByteString
bs,SockAddr
sa,[Cmsg]
cmsg,MsgFlag
_) <- Socket
-> Int
-> Int
-> MsgFlag
-> IO (ByteString, SockAddr, [Cmsg], MsgFlag)
R.recvMsg Socket
listenSocket Int
properUDPSize Int
properCMSGSize MsgFlag
0
        (ByteString, ClientSockAddr) -> IO (ByteString, ClientSockAddr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, SockAddr -> [Cmsg] -> ClientSockAddr
ClientSockAddr SockAddr
sa [Cmsg]
cmsg)
  | Bool
otherwise = do
        (ByteString
bs,SockAddr
sa) <- Socket -> Int -> IO (ByteString, SockAddr)
R.recvFrom Socket
listenSocket Int
properUDPSize
        (ByteString, ClientSockAddr) -> IO (ByteString, ClientSockAddr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, SockAddr -> [Cmsg] -> ClientSockAddr
ClientSockAddr SockAddr
sa [])

-- | Sending data with a listening UDP socket.
--   For a wildcard socket, sendmsg() is called.
--   For an interface specific socket, sento() is called.
sendTo :: ListenSocket -> ByteString -> ClientSockAddr -> IO ()
sendTo :: ListenSocket -> ByteString -> ClientSockAddr -> IO ()
sendTo ListenSocket{Bool
SockAddr
Socket
listenSocket :: ListenSocket -> Socket
mySockAddr :: ListenSocket -> SockAddr
wildcard :: ListenSocket -> Bool
listenSocket :: Socket
mySockAddr :: SockAddr
wildcard :: Bool
..} ByteString
bs (ClientSockAddr SockAddr
sa [Cmsg]
cmsgs)
  | Bool
wildcard  = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> [ByteString] -> [Cmsg] -> MsgFlag -> IO Int
NSB.sendMsg Socket
listenSocket SockAddr
sa [ByteString
bs] [Cmsg]
cmsgs MsgFlag
0
  | Bool
otherwise = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> SockAddr -> IO Int
NSB.sendTo  Socket
listenSocket ByteString
bs SockAddr
sa

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

-- | Creating a connected UDP socket like TCP's accept().
accept :: ListenSocket -> ClientSockAddr -> IO UDPSocket
accept :: ListenSocket -> ClientSockAddr -> IO UDPSocket
accept ListenSocket{Bool
SockAddr
Socket
listenSocket :: ListenSocket -> Socket
mySockAddr :: ListenSocket -> SockAddr
wildcard :: ListenSocket -> Bool
listenSocket :: Socket
mySockAddr :: SockAddr
wildcard :: Bool
..} (ClientSockAddr SockAddr
peersa [Cmsg]
cmsgs) = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError IO Socket
open Socket -> IO ()
NS.close ((Socket -> IO UDPSocket) -> IO UDPSocket)
-> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
    Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
s SocketOption
ReuseAddr Int
1
    Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s CInt -> IO ()
setCloseOnExecIfNeeded
    let mysa' :: SockAddr
mysa' | Bool
wildcard  = SockAddr -> [Cmsg] -> SockAddr
getMySockAddr SockAddr
mySockAddr [Cmsg]
cmsgs
              | Bool
otherwise = SockAddr -> SockAddr
anySockAddr SockAddr
mySockAddr
    -- wildcard:  (UDP, *.443, *:*) -> (UDP, 127.0.0.1:443, *:*)
    -- otherwise: (UDP, 127.0.0.1:443, *:*) -> (UDP, *:443, *:*)
    Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
mysa'
    -- bind and connect is not atomic
    -- So, bind may results in EADDRINUSE
       IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` IO () -> IOError -> IO ()
forall {b}. IO b -> IOError -> IO b
postphone (Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
mysa')
    Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
peersa  -- (UDP, 127.0.0.1:443, pa:pp)
    UDPSocket -> IO UDPSocket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UDPSocket -> IO UDPSocket) -> UDPSocket -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> Bool -> UDPSocket
UDPSocket Socket
s SockAddr
peersa Bool
True
  where
    postphone :: IO b -> IOError -> IO b
postphone IO b
action IOError
e
      | IOError -> IOErrorType
E.ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
E.ResourceBusy = Int -> IO ()
threadDelay Int
10000 IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
action
      | Bool
otherwise                             = IOError -> IO b
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
    family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
mySockAddr
    open :: IO Socket
open   = Family -> SocketType -> CInt -> IO Socket
socket Family
family SocketType
Datagram CInt
defaultProtocol

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

-- | Creating a unconnected UDP socket.
clientSocket :: HostName -> ServiceName -> Bool -> IO UDPSocket
clientSocket :: [Char] -> [Char] -> Bool -> IO UDPSocket
clientSocket [Char]
host [Char]
port Bool
conn = do
    AddrInfo
addr <- [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO [AddrInfo]
NS.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
host) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
port)
    IO Socket
-> (Socket -> IO ()) -> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (AddrInfo -> IO Socket
NS.openSocket AddrInfo
addr) Socket -> IO ()
NS.close ((Socket -> IO UDPSocket) -> IO UDPSocket)
-> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
        let sa :: SockAddr
sa = AddrInfo -> SockAddr
addrAddress AddrInfo
addr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
NS.connect Socket
s SockAddr
sa
        UDPSocket -> IO UDPSocket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UDPSocket -> IO UDPSocket) -> UDPSocket -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> Bool -> UDPSocket
UDPSocket Socket
s SockAddr
sa Bool
conn
 where
    hints :: AddrInfo
hints = AddrInfo
NS.defaultHints { addrSocketType = Datagram }

-- | Sending data with a UDP socket.
--   If the socket is connected, send() is called.
--   Otherwise, sento() is called.
send :: UDPSocket -> (ByteString -> IO ())
send :: UDPSocket -> ByteString -> IO ()
send UDPSocket{Bool
SockAddr
Socket
udpSocket :: UDPSocket -> Socket
peerSockAddr :: UDPSocket -> SockAddr
connected :: UDPSocket -> Bool
udpSocket :: Socket
peerSockAddr :: SockAddr
connected :: Bool
..}
  | Bool
connected = \ByteString
bs -> IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> IO Int
NSB.send   Socket
udpSocket ByteString
bs
  | Bool
otherwise = \ByteString
bs -> IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> SockAddr -> IO Int
NSB.sendTo Socket
udpSocket ByteString
bs SockAddr
peerSockAddr

-- | Receiving data with a UDP socket.
--   If the socket is connected, recv() is called.
--   Otherwise, recvfrom() is called.
recv :: UDPSocket -> IO ByteString
recv :: UDPSocket -> IO ByteString
recv UDPSocket{Bool
SockAddr
Socket
udpSocket :: UDPSocket -> Socket
peerSockAddr :: UDPSocket -> SockAddr
connected :: UDPSocket -> Bool
udpSocket :: Socket
peerSockAddr :: SockAddr
connected :: Bool
..}
  | Bool
connected = Socket -> Int -> IO ByteString
R.recv Socket
udpSocket Int
properUDPSize
  | Bool
otherwise = IO ByteString
go
  where
    go :: IO ByteString
go = do
        (ByteString
bs, SockAddr
sa) <- Socket -> Int -> IO (ByteString, SockAddr)
R.recvFrom Socket
udpSocket Int
properUDPSize
        if SockAddr
sa SockAddr -> SockAddr -> Bool
forall a. Eq a => a -> a -> Bool
== SockAddr
peerSockAddr then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs else IO ByteString
go

-- | Sending data in a buffer with a UDP socket.
--   If the socket is connected, send() is called.
--   Otherwise, sento() is called.
sendBuf :: UDPSocket -> (Ptr Word8 -> Int -> IO ())
sendBuf :: UDPSocket -> Ptr Word8 -> Int -> IO ()
sendBuf UDPSocket{Bool
SockAddr
Socket
udpSocket :: UDPSocket -> Socket
peerSockAddr :: UDPSocket -> SockAddr
connected :: UDPSocket -> Bool
udpSocket :: Socket
peerSockAddr :: SockAddr
connected :: Bool
..} Ptr Word8
ptr Int
siz
  | Bool
connected = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> Ptr Word8 -> Int -> IO Int
NS.sendBuf   Socket
udpSocket Ptr Word8
ptr Int
siz
  | Bool
otherwise = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> Ptr Word8 -> Int -> SockAddr -> IO Int
forall a. Socket -> Ptr a -> Int -> SockAddr -> IO Int
NS.sendBufTo Socket
udpSocket Ptr Word8
ptr Int
siz SockAddr
peerSockAddr

-- | Receiving data in a buffer with a UDP socket.
--   If the socket is connected, recv() is called.
--   Otherwise, recvfrom() is called.
recvBuf :: UDPSocket -> (Ptr Word8 -> Int -> IO Int)
recvBuf :: UDPSocket -> Ptr Word8 -> Int -> IO Int
recvBuf UDPSocket{Bool
SockAddr
Socket
udpSocket :: UDPSocket -> Socket
peerSockAddr :: UDPSocket -> SockAddr
connected :: UDPSocket -> Bool
udpSocket :: Socket
peerSockAddr :: SockAddr
connected :: Bool
..} Ptr Word8
ptr Int
siz
  | Bool
connected = Socket -> Ptr Word8 -> Int -> IO Int
NS.recvBuf   Socket
udpSocket Ptr Word8
ptr Int
siz
  | Bool
otherwise = IO Int
go
  where
    go :: IO Int
go = do
        (Int
len,SockAddr
sa) <- Socket -> Ptr Word8 -> Int -> IO (Int, SockAddr)
forall a. Socket -> Ptr a -> Int -> IO (Int, SockAddr)
NS.recvBufFrom Socket
udpSocket Ptr Word8
ptr Int
siz
        if SockAddr
sa SockAddr -> SockAddr -> Bool
forall a. Eq a => a -> a -> Bool
== SockAddr
peerSockAddr then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
len else IO Int
go

-- | Closing a socket.
stop :: ListenSocket -> IO ()
stop :: ListenSocket -> IO ()
stop (ListenSocket Socket
s SockAddr
_ Bool
_) = Socket -> IO ()
NS.close Socket
s

-- | Closing a socket.
close :: UDPSocket -> IO ()
close :: UDPSocket -> IO ()
close (UDPSocket Socket
s SockAddr
_ Bool
_) = Socket -> IO ()
NS.close Socket
s

-- | Emulation of NAT rebiding in the client side.
--   This is mainly used for test purposes.
natRebinding :: UDPSocket -> IO UDPSocket
natRebinding :: UDPSocket -> IO UDPSocket
natRebinding (UDPSocket Socket
_ SockAddr
sa Bool
conn) = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError IO Socket
open Socket -> IO ()
NS.close ((Socket -> IO UDPSocket) -> IO UDPSocket)
-> (Socket -> IO UDPSocket) -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
NS.connect Socket
s SockAddr
sa
    UDPSocket -> IO UDPSocket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UDPSocket -> IO UDPSocket) -> UDPSocket -> IO UDPSocket
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> Bool -> UDPSocket
UDPSocket Socket
s SockAddr
sa Bool
conn
  where
    family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
sa
    open :: IO Socket
open = Family -> SocketType -> CInt -> IO Socket
NS.socket Family
family SocketType
Datagram CInt
NS.defaultProtocol

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

decideOption :: SockAddr -> SocketOption
decideOption :: SockAddr -> SocketOption
decideOption SockAddrInet{}  = SocketOption
RecvIPv4PktInfo
decideOption SockAddrInet6{} = SocketOption
RecvIPv6PktInfo
decideOption SockAddr
_               = [Char] -> SocketOption
forall a. HasCallStack => [Char] -> a
error [Char]
"decideOption"

-- | Obtaining my sockaddr for a wildcard socket from cmsgs.
getMySockAddr :: SockAddr -> [Cmsg] -> SockAddr
getMySockAddr :: SockAddr -> [Cmsg] -> SockAddr
getMySockAddr (SockAddrInet PortNumber
p HostAddress
_) [Cmsg]
cmsgs = PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
p HostAddress
addr
  where
    pktinfo :: Cmsg
pktinfo = Maybe Cmsg -> Cmsg
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Cmsg -> Cmsg) -> Maybe Cmsg -> Cmsg
forall a b. (a -> b) -> a -> b
$ CmsgId -> [Cmsg] -> Maybe Cmsg
lookupCmsg CmsgId
CmsgIdIPv4PktInfo [Cmsg]
cmsgs
    IPv4PktInfo Int
_ HostAddress
_ HostAddress
addr = Maybe IPv4PktInfo -> IPv4PktInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IPv4PktInfo -> IPv4PktInfo)
-> Maybe IPv4PktInfo -> IPv4PktInfo
forall a b. (a -> b) -> a -> b
$ Cmsg -> Maybe IPv4PktInfo
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeCmsg Cmsg
pktinfo
getMySockAddr (SockAddrInet6 PortNumber
p HostAddress
f HostAddress6
_ HostAddress
sc) [Cmsg]
cmsgs = PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
SockAddrInet6 PortNumber
p HostAddress
f HostAddress6
addr HostAddress
sc
  where
    pktinfo :: Cmsg
pktinfo = Maybe Cmsg -> Cmsg
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Cmsg -> Cmsg) -> Maybe Cmsg -> Cmsg
forall a b. (a -> b) -> a -> b
$ CmsgId -> [Cmsg] -> Maybe Cmsg
lookupCmsg CmsgId
CmsgIdIPv6PktInfo [Cmsg]
cmsgs
    IPv6PktInfo Int
_ HostAddress6
addr = Maybe IPv6PktInfo -> IPv6PktInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IPv6PktInfo -> IPv6PktInfo)
-> Maybe IPv6PktInfo -> IPv6PktInfo
forall a b. (a -> b) -> a -> b
$ Cmsg -> Maybe IPv6PktInfo
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeCmsg Cmsg
pktinfo
getMySockAddr SockAddr
_ [Cmsg]
_ = [Char] -> SockAddr
forall a. HasCallStack => [Char] -> a
error [Char]
"getMySockAddr"