module Network.QUIC.Socket where
import Control.Concurrent
import qualified UnliftIO.Exception as E
import Data.IP hiding (addr)
import qualified GHC.IO.Exception as E
import Network.Socket
import qualified System.IO.Error as E
sockAddrFamily :: SockAddr -> Family
sockAddrFamily :: SockAddr -> Family
sockAddrFamily SockAddrInet{} = Family
AF_INET
sockAddrFamily SockAddrInet6{} = Family
AF_INET6
sockAddrFamily SockAddr
_ = [Char] -> Family
forall a. HasCallStack => [Char] -> a
error [Char]
"sockAddrFamily"
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"
udpServerListenSocket :: (IP, PortNumber) -> IO (Socket, SockAddr)
udpServerListenSocket :: (IP, PortNumber) -> IO (Socket, SockAddr)
udpServerListenSocket (IP, PortNumber)
ip = IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (Socket, SockAddr))
-> IO (Socket, SockAddr)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError IO Socket
open Socket -> IO ()
close ((Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr))
-> (Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
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
Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
sa
(Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
s,SockAddr
sa)
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
udpServerConnectedSocket :: SockAddr -> SockAddr -> IO Socket
udpServerConnectedSocket :: SockAddr -> SockAddr -> IO Socket
udpServerConnectedSocket SockAddr
mysa SockAddr
peersa = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError IO Socket
open Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
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
Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
anysa
IO () -> (IOError -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` IO () -> IOError -> IO ()
forall b. IO b -> IOError -> IO b
postphone (Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
anysa)
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
peersa
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
s
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
action
| Bool
otherwise = IOError -> IO b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO IOError
e
anysa :: SockAddr
anysa = SockAddr -> SockAddr
anySockAddr SockAddr
mysa
family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
mysa
open :: IO Socket
open = Family -> SocketType -> CInt -> IO Socket
socket Family
family SocketType
Datagram CInt
defaultProtocol
udpClientSocket :: HostName -> ServiceName -> IO (Socket,SockAddr)
udpClientSocket :: [Char] -> [Char] -> IO (Socket, SockAddr)
udpClientSocket [Char]
host [Char]
port = do
AddrInfo
addr <- [AddrInfo] -> AddrInfo
forall a. [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]
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 (Socket, SockAddr))
-> IO (Socket, SockAddr)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError (AddrInfo -> IO Socket
openSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr))
-> (Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
let sa :: SockAddr
sa = AddrInfo -> SockAddr
addrAddress AddrInfo
addr
(Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
s,SockAddr
sa)
where
hints :: AddrInfo
hints = AddrInfo
defaultHints { addrSocketType :: SocketType
addrSocketType = SocketType
Datagram }
udpClientConnectedSocket :: HostName -> ServiceName -> IO (Socket,SockAddr)
udpClientConnectedSocket :: [Char] -> [Char] -> IO (Socket, SockAddr)
udpClientConnectedSocket [Char]
host [Char]
port = do
AddrInfo
addr <- [AddrInfo] -> AddrInfo
forall a. [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]
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 (Socket, SockAddr))
-> IO (Socket, SockAddr)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError (AddrInfo -> IO Socket
openSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr))
-> (Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
let sa :: SockAddr
sa = AddrInfo -> SockAddr
addrAddress AddrInfo
addr
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
sa
(Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
s,SockAddr
sa)
where
hints :: AddrInfo
hints = AddrInfo
defaultHints { addrSocketType :: SocketType
addrSocketType = SocketType
Datagram }
udpNATRebindingSocket :: SockAddr -> IO Socket
udpNATRebindingSocket :: SockAddr -> IO Socket
udpNATRebindingSocket SockAddr
peersa = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError IO Socket
open Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ \Socket
s ->
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
s
where
family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
peersa
open :: IO Socket
open = Family -> SocketType -> CInt -> IO Socket
socket Family
family SocketType
Datagram CInt
defaultProtocol
udpNATRebindingConnectedSocket :: SockAddr -> IO Socket
udpNATRebindingConnectedSocket :: SockAddr -> IO Socket
udpNATRebindingConnectedSocket SockAddr
peersa = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError IO Socket
open Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
peersa
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
s
where
family :: Family
family = SockAddr -> Family
sockAddrFamily SockAddr
peersa
open :: IO Socket
open = Family -> SocketType -> CInt -> IO Socket
socket Family
family SocketType
Datagram CInt
defaultProtocol