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

-- | Simple functions to run TCP clients and servers.
module Network.Run.TCP (
    -- * Server
    runTCPServer,
    runTCPServerWithSocket,
    openTCPServerSocket,
    openTCPServerSocketWithOptions,
    openTCPServerSocketWithOpts,
    resolve,

    -- * Client
    runTCPClient,
    Settings,
    defaultSettings,
    settingsOpenClientSocket,
    runTCPClientWithSettings,
    openClientSocket,
    openClientSocketWithOptions,
    openClientSocketWithOpts,
) where

import Control.Concurrent (forkFinally, threadDelay, forkIO)
import qualified Control.Exception as E
import Control.Monad (forever, void)
import Network.Socket

import Network.Run.Core

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

-- | Running a TCP server with an accepted socket and its peer name.
runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
runTCPServer :: forall a. Maybe HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPServer Maybe HostName
mhost HostName
port Socket -> IO a
server = IO a -> IO a
forall a. IO a -> IO a
withSocketsDo (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    AddrInfo
addr <- SocketType
-> Maybe HostName -> HostName -> [AddrInfoFlag] -> IO AddrInfo
resolve SocketType
Stream Maybe HostName
mhost HostName
port [AddrInfoFlag
AI_PASSIVE]
    IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (AddrInfo -> IO Socket
openTCPServerSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO a) -> IO a) -> (Socket -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Socket
sock ->
        Socket -> (Socket -> IO a) -> IO a
forall a. Socket -> (Socket -> IO a) -> IO a
runTCPServerWithSocket Socket
sock Socket -> IO a
server

-- | Running a TCP client with a connected socket for a given listen
-- socket.
runTCPServerWithSocket
    :: Socket
    -> (Socket -> IO a)
    -- ^ Called for each incoming connection, in a new thread
    -> IO a
runTCPServerWithSocket :: forall a. Socket -> (Socket -> IO a) -> IO a
runTCPServerWithSocket Socket
sock Socket -> IO a
server = IO a -> IO a
forall a. IO a -> IO a
withSocketsDo (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
    IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$
        IO (Socket, SockAddr)
-> ((Socket, SockAddr) -> IO ())
-> ((Socket, SockAddr) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (Socket -> IO (Socket, SockAddr)
accept Socket
sock) (Socket -> IO ()
close (Socket -> IO ())
-> ((Socket, SockAddr) -> Socket) -> (Socket, SockAddr) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst) (((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \(Socket
conn, SockAddr
_peer) ->
                IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (HostName -> IO ()
labelMe HostName
"TCP server" IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Socket -> IO a
server Socket
conn) (IO () -> Either SomeException a -> IO ()
forall a b. a -> b -> a
const (IO () -> Either SomeException a -> IO ())
-> IO () -> Either SomeException a -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
gclose Socket
conn)

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

-- | Settings for client.
data Settings = Settings
    { Settings -> AddrInfo -> IO Socket
settingsOpenClientSocket :: AddrInfo -> IO Socket
    -- ^ Opening a socket. Use 'openClientSocketWithOptions' to specify 'SocketOption'
    }

-- | Default settings.
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
    Settings
        { settingsOpenClientSocket :: AddrInfo -> IO Socket
settingsOpenClientSocket = AddrInfo -> IO Socket
openClientSocket
        }

-- | Running a TCP client with a connected socket.
--
-- This is the same as:
--
-- @
-- 'runTCPClientWithSettings' 'defaultSettings'
-- @
runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a
runTCPClient :: forall a. HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPClient = Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
forall a.
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings
defaultSettings

-- | Running a TCP client with a connected socket.
runTCPClientWithSettings
    :: Settings
    -> HostName
    -> ServiceName
    -> (Socket -> IO a)
    -> IO a
runTCPClientWithSettings :: forall a.
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings{AddrInfo -> IO Socket
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsOpenClientSocket :: AddrInfo -> IO Socket
..} HostName
host HostName
port Socket -> IO a
client = IO a -> IO a
forall a. IO a -> IO a
withSocketsDo (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    AddrInfo
addr <- SocketType
-> Maybe HostName -> HostName -> [AddrInfoFlag] -> IO AddrInfo
resolve SocketType
Stream (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
host) HostName
port [AddrInfoFlag
AI_ADDRCONFIG]
    IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (AddrInfo -> IO Socket
settingsOpenClientSocket AddrInfo
addr) Socket -> IO ()
close Socket -> IO a
client