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
    -- setSocketOption s IPv6Only 1 -- fixme
    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
    -- bind and connect is not atomic
    -- So, bind may results in EADDRINUSE
    Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
anysa      -- (UDP, *:13443, *:*)
       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  -- (UDP, 127.0.0.1:13443, pa:pp)
    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