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

module Network.Run.Core (
    resolve,
    openSocket,
    openClientSocket,
    openClientSocketWithOptions,
    openServerSocket,
    openServerSocketWithOptions,
    openTCPServerSocket,
    openTCPServerSocketWithOptions,
    gclose,
    labelMe,
) where

import qualified Control.Exception as E
import Control.Monad (when)
import Network.Socket
import GHC.Conc.Sync

resolve
    :: SocketType
    -> Maybe HostName
    -> ServiceName
    -> [AddrInfoFlag]
    -> IO AddrInfo
resolve :: SocketType
-> Maybe HostName -> HostName -> [AddrInfoFlag] -> IO AddrInfo
resolve SocketType
socketType Maybe HostName
mhost HostName
port [AddrInfoFlag]
flags =
    [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 HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe HostName
mhost (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
port)
  where
    hints :: AddrInfo
hints =
        AddrInfo
defaultHints
            { addrSocketType = socketType
            , addrFlags = flags
            }

#if !MIN_VERSION_network(3,1,2)
openSocket :: AddrInfo -> IO Socket
openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
#endif

-- | This is the same as
--
-- > openClientSocketWithOptions []
openClientSocket :: AddrInfo -> IO Socket
openClientSocket :: AddrInfo -> IO Socket
openClientSocket = [(SocketOption, Int)] -> AddrInfo -> IO Socket
openClientSocketWithOptions []

openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openClientSocketWithOptions [(SocketOption, Int)]
opts AddrInfo
addr = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (AddrInfo -> IO Socket
openSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
    ((SocketOption, Int) -> IO ()) -> [(SocketOption, Int)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ())
-> (SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock) [(SocketOption, Int)]
opts
    Socket -> SockAddr -> IO ()
connect Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
    Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

-- | Open socket for server use
--
-- This is the same as:
--
-- > openServerSocketWithOptions []
openServerSocket :: AddrInfo -> IO Socket
openServerSocket :: AddrInfo -> IO Socket
openServerSocket = [(SocketOption, Int)] -> AddrInfo -> IO Socket
openServerSocketWithOptions []

-- | Open socket for server use, and set the provided options before binding.
--
-- In addition to the given options, the socket is configured to
--
-- * allow reuse of local addresses (SO_REUSEADDR)
-- * automatically be closed during a successful @execve@ (FD_CLOEXEC)
-- * bind to the address specified
openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openServerSocketWithOptions [(SocketOption, Int)]
opts AddrInfo
addr = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (AddrInfo -> IO Socket
openSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
    Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr Int
1
#if !defined(openbsd_HOST_OS)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddrInfo -> Family
addrFamily AddrInfo
addr 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
sock SocketOption
IPv6Only Int
1
#endif
    ((SocketOption, Int) -> IO ()) -> [(SocketOption, Int)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ())
-> (SocketOption -> Int -> IO ()) -> (SocketOption, Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock) [(SocketOption, Int)]
opts
    Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
sock CInt -> IO ()
setCloseOnExecIfNeeded
    Socket -> SockAddr -> IO ()
bind Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
    Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

-- | Open TCP socket for server use
--
-- This is the same as:
--
-- > openTCPServerSocketWithOptions []
openTCPServerSocket :: AddrInfo -> IO Socket
openTCPServerSocket :: AddrInfo -> IO Socket
openTCPServerSocket = [(SocketOption, Int)] -> AddrInfo -> IO Socket
openTCPServerSocketWithOptions []

-- | Open socket for server use, and set the provided options before binding.
--
-- In addition to the given options, the socket is configured to
--
-- * allow reuse of local addresses (SO_REUSEADDR)
-- * automatically be closed during a successful @execve@ (FD_CLOEXEC)
-- * bind to the address specified
-- * listen with queue length with 1024
openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
openTCPServerSocketWithOptions [(SocketOption, Int)]
opts AddrInfo
addr = do
    Socket
sock <- [(SocketOption, Int)] -> AddrInfo -> IO Socket
openServerSocketWithOptions [(SocketOption, Int)]
opts AddrInfo
addr
    Socket -> Int -> IO ()
listen Socket
sock Int
1024
    Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

gclose :: Socket -> IO ()
#if MIN_VERSION_network(3,1,1)
gclose :: Socket -> IO ()
gclose Socket
sock = Socket -> Int -> IO ()
gracefulClose Socket
sock Int
5000
#else
gclose = close
#endif

labelMe :: String -> IO ()
labelMe :: HostName -> IO ()
labelMe HostName
name = do
    ThreadId
tid <- IO ThreadId
myThreadId
    ThreadId -> HostName -> IO ()
labelThread ThreadId
tid HostName
name