{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
module Data.Streaming.Network
    ( -- * Types
      ServerSettings
    , ClientSettings
    , HostPreference
    , Message (..)
    , AppData
#if !WINDOWS
    , ServerSettingsUnix
    , ClientSettingsUnix
    , AppDataUnix
#endif
      -- ** Smart constructors
    , serverSettingsTCP
    , serverSettingsTCPSocket
    , clientSettingsTCP
    , serverSettingsUDP
    , clientSettingsUDP
#if !WINDOWS
    , serverSettingsUnix
    , clientSettingsUnix
#endif
    , message
      -- ** Classes
    , HasPort (..)
    , HasAfterBind (..)
    , HasReadWrite (..)
    , HasReadBufferSize (..)
#if !WINDOWS
    , HasPath (..)
#endif
      -- ** Setters
    , setPort
    , setHost
    , setAddrFamily
    , setAfterBind
    , setNeedLocalAddr
    , setReadBufferSize
#if !WINDOWS
    , setPath
#endif
      -- ** Getters
    , getPort
    , getHost
    , getAddrFamily
    , getAfterBind
    , getNeedLocalAddr
    , getReadBufferSize
#if !WINDOWS
    , getPath
#endif
    , appRead
    , appWrite
    , appSockAddr
    , appLocalAddr
    , appCloseConnection
    , appRawSocket
      -- * Functions
      -- ** General
    , bindPortGen
    , bindPortGenEx
    , bindRandomPortGen
    , getSocketGen
    , getSocketFamilyGen
    , acceptSafe
    , unassignedPorts
    , getUnassignedPort
      -- ** TCP
    , bindPortTCP
    , bindRandomPortTCP
    , getSocketTCP
    , getSocketFamilyTCP
    , safeRecv
    , runTCPServer
    , runTCPClient
    , ConnectionHandle()
    , runTCPServerWithHandle
      -- ** UDP
    , bindPortUDP
    , bindRandomPortUDP
    , getSocketUDP
#if !WINDOWS
      -- ** Unix
    , bindPath
    , getSocketUnix
    , runUnixServer
    , runUnixClient
#endif
    ) where

import qualified Network.Socket as NS
import Data.Streaming.Network.Internal
import Control.Concurrent (threadDelay)
import Control.Exception (IOException, try, SomeException, throwIO, bracketOnError, bracket)
import Network.Socket (Socket, AddrInfo, SocketType)
import Network.Socket.ByteString (recv, sendAll)
import System.IO.Error (isDoesNotExistError)
import qualified Data.ByteString.Char8 as S8
import qualified Control.Exception as E
import Data.ByteString (ByteString)
import System.Directory (removeFile)
import Data.Functor.Constant (Constant (Constant), getConstant)
import Data.Functor.Identity (Identity (Identity), runIdentity)
import Control.Concurrent (forkIO)
import Control.Monad (forever)
import Data.IORef (IORef, newIORef, atomicModifyIORef)
import Data.Array.Unboxed ((!), UArray, listArray)
import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
import System.Random (randomRIO)
import System.IO.Error (isFullErrorType, ioeGetErrorType)
#if WINDOWS
import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar)
#endif

getPossibleAddrs :: SocketType -> String -> Int -> NS.Family -> IO [AddrInfo]
getPossibleAddrs :: SocketType -> String -> Int -> Family -> IO [AddrInfo]
getPossibleAddrs SocketType
sockettype String
host' Int
port' Family
af =
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host') (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port')
  where
    hints :: AddrInfo
hints = AddrInfo
NS.defaultHints {
                addrSocketType :: SocketType
NS.addrSocketType = SocketType
sockettype
              , addrFamily :: Family
NS.addrFamily = Family
af
              }

-- | Attempt to connect to the given host/port/address family using given @SocketType@.
--
-- Since 0.1.3
getSocketFamilyGen :: SocketType -> String -> Int -> NS.Family -> IO (Socket, AddrInfo)
getSocketFamilyGen :: SocketType -> String -> Int -> Family -> IO (Socket, AddrInfo)
getSocketFamilyGen SocketType
sockettype String
host' Int
port' Family
af = do
    (AddrInfo
addr:[AddrInfo]
_) <- SocketType -> String -> Int -> Family -> IO [AddrInfo]
getPossibleAddrs SocketType
sockettype String
host' Int
port' Family
af
    Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket (AddrInfo -> Family
NS.addrFamily AddrInfo
addr) (AddrInfo -> SocketType
NS.addrSocketType AddrInfo
addr)
                      (AddrInfo -> ProtocolNumber
NS.addrProtocol AddrInfo
addr)
    (Socket, AddrInfo) -> IO (Socket, AddrInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo
addr)

-- | Attempt to connect to the given host/port using given @SocketType@.
getSocketGen :: SocketType -> String -> Int -> IO (Socket, AddrInfo)
getSocketGen :: SocketType -> String -> Int -> IO (Socket, AddrInfo)
getSocketGen SocketType
sockettype String
host Int
port = SocketType -> String -> Int -> Family -> IO (Socket, AddrInfo)
getSocketFamilyGen SocketType
sockettype String
host Int
port Family
NS.AF_UNSPEC

defaultSocketOptions :: SocketType -> [(NS.SocketOption, Int)]
defaultSocketOptions :: SocketType -> [(SocketOption, Int)]
defaultSocketOptions SocketType
sockettype =
    case SocketType
sockettype of
        SocketType
NS.Datagram -> [(SocketOption
NS.ReuseAddr,Int
1)]
        SocketType
_           -> [(SocketOption
NS.NoDelay,Int
1), (SocketOption
NS.ReuseAddr,Int
1)]

-- | Attempt to bind a listening @Socket@ on the given host/port using given
-- @SocketType@. If no host is given, will use the first address available.
bindPortGen :: SocketType -> Int -> HostPreference -> IO Socket
bindPortGen :: SocketType -> Int -> HostPreference -> IO Socket
bindPortGen SocketType
sockettype = [(SocketOption, Int)]
-> SocketType -> Int -> HostPreference -> IO Socket
bindPortGenEx (SocketType -> [(SocketOption, Int)]
defaultSocketOptions SocketType
sockettype) SocketType
sockettype

-- | Attempt to bind a listening @Socket@ on the given host/port using given
-- socket options and @SocketType@. If no host is given, will use the first address available.
--
-- Since 0.1.17
bindPortGenEx :: [(NS.SocketOption, Int)] -> SocketType -> Int -> HostPreference -> IO Socket
bindPortGenEx :: [(SocketOption, Int)]
-> SocketType -> Int -> HostPreference -> IO Socket
bindPortGenEx [(SocketOption, Int)]
sockOpts SocketType
sockettype Int
p HostPreference
s = do
    let hints :: AddrInfo
hints = AddrInfo
NS.defaultHints
            { addrFlags :: [AddrInfoFlag]
NS.addrFlags = [AddrInfoFlag
NS.AI_PASSIVE]
            , addrSocketType :: SocketType
NS.addrSocketType = SocketType
sockettype
            }
        host :: Maybe String
host =
            case HostPreference
s of
                Host String
s' -> String -> Maybe String
forall a. a -> Maybe a
Just String
s'
                HostPreference
_ -> Maybe String
forall a. Maybe a
Nothing
        port :: Maybe String
port = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> (Int -> String) -> Int -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Maybe String) -> Int -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int
p
    [AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe String
host Maybe String
port
    -- Choose an IPv6 socket if exists.  This ensures the socket can
    -- handle both IPv4 and IPv6 if v6only is false.
    let addrs4 :: [AddrInfo]
addrs4 = (AddrInfo -> Bool) -> [AddrInfo] -> [AddrInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AddrInfo
x -> AddrInfo -> Family
NS.addrFamily AddrInfo
x Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
/= Family
NS.AF_INET6) [AddrInfo]
addrs
        addrs6 :: [AddrInfo]
addrs6 = (AddrInfo -> Bool) -> [AddrInfo] -> [AddrInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AddrInfo
x -> AddrInfo -> Family
NS.addrFamily AddrInfo
x Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
NS.AF_INET6) [AddrInfo]
addrs
        addrs' :: [AddrInfo]
addrs' =
            case HostPreference
s of
                HostPreference
HostIPv4     -> [AddrInfo]
addrs4 [AddrInfo] -> [AddrInfo] -> [AddrInfo]
forall a. [a] -> [a] -> [a]
++ [AddrInfo]
addrs6
                HostPreference
HostIPv4Only -> [AddrInfo]
addrs4
                HostPreference
HostIPv6     -> [AddrInfo]
addrs6 [AddrInfo] -> [AddrInfo] -> [AddrInfo]
forall a. [a] -> [a] -> [a]
++ [AddrInfo]
addrs4
                HostPreference
HostIPv6Only -> [AddrInfo]
addrs6
                HostPreference
_ -> [AddrInfo]
addrs

        tryAddrs :: [AddrInfo] -> IO Socket
tryAddrs (AddrInfo
addr1:rest :: [AddrInfo]
rest@(AddrInfo
_:[AddrInfo]
_)) =
                                      IO Socket -> (IOException -> IO Socket) -> IO Socket
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                                      (AddrInfo -> IO Socket
theBody AddrInfo
addr1)
                                      (\(IOException
_ :: IOException) -> [AddrInfo] -> IO Socket
tryAddrs [AddrInfo]
rest)
        tryAddrs (AddrInfo
addr1:[])         = AddrInfo -> IO Socket
theBody AddrInfo
addr1
        tryAddrs [AddrInfo]
_                  = String -> IO Socket
forall a. HasCallStack => String -> a
error String
"bindPort: addrs is empty"

        theBody :: AddrInfo -> IO Socket
theBody 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
bracketOnError
          (Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket (AddrInfo -> Family
NS.addrFamily AddrInfo
addr) (AddrInfo -> SocketType
NS.addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
NS.addrProtocol AddrInfo
addr))
          Socket -> IO ()
NS.close
          (\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
opt,Int
v) -> Socket -> SocketOption -> Int -> IO ()
NS.setSocketOption Socket
sock SocketOption
opt Int
v) [(SocketOption, Int)]
sockOpts
              Socket -> SockAddr -> IO ()
NS.bind Socket
sock (AddrInfo -> SockAddr
NS.addrAddress AddrInfo
addr)
              Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
          )
    [AddrInfo] -> IO Socket
tryAddrs [AddrInfo]
addrs'

-- | Bind to a random port number. Especially useful for writing network tests.
--
-- Since 0.1.1
bindRandomPortGen :: SocketType -> HostPreference -> IO (Int, Socket)
bindRandomPortGen :: SocketType -> HostPreference -> IO (Int, Socket)
bindRandomPortGen SocketType
sockettype HostPreference
s = do
  Socket
socket <- SocketType -> Int -> HostPreference -> IO Socket
bindPortGen SocketType
sockettype Int
0 HostPreference
s
  PortNumber
port <- Socket -> IO PortNumber
NS.socketPort Socket
socket
  (Int, Socket) -> IO (Int, Socket)
forall (m :: * -> *) a. Monad m => a -> m a
return (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port, Socket
socket)

-- | Top 10 Largest IANA unassigned port ranges with no unauthorized uses known
unassignedPortsList :: [Int]
unassignedPortsList :: [Int]
unassignedPortsList = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Int
43124..Int
44320]
    , [Int
28120..Int
29166]
    , [Int
45967..Int
46997]
    , [Int
28241..Int
29117]
    , [Int
40001..Int
40840]
    , [Int
29170..Int
29998]
    , [Int
38866..Int
39680]
    , [Int
43442..Int
44122]
    , [Int
41122..Int
41793]
    , [Int
35358..Int
36000]
    ]

unassignedPorts :: UArray Int Int
unassignedPorts :: UArray Int Int
unassignedPorts = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
unassignedPortsMin, Int
unassignedPortsMax) [Int]
unassignedPortsList

unassignedPortsMin, unassignedPortsMax :: Int
unassignedPortsMin :: Int
unassignedPortsMin = Int
0
unassignedPortsMax :: Int
unassignedPortsMax = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
unassignedPortsList Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

nextUnusedPort :: IORef Int
nextUnusedPort :: IORef Int
nextUnusedPort = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO
               (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
unassignedPortsMin, Int
unassignedPortsMax) IO Int -> (Int -> IO (IORef Int)) -> IO (IORef Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef
{-# NOINLINE nextUnusedPort #-}

-- | Get a port from the IANA list of unassigned ports.
--
-- Internally, this function uses an @IORef@ to cycle through the list of ports
getUnassignedPort :: IO Int
getUnassignedPort :: IO Int
getUnassignedPort = do
    Int
port <- IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Int
nextUnusedPort Int -> (Int, Int)
go
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Int
port
  where
    go :: Int -> (Int, Int)
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unassignedPortsMax = (Int -> Int
forall a. Enum a => a -> a
succ Int
unassignedPortsMin, UArray Int Int
unassignedPorts UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
unassignedPortsMin)
        | Bool
otherwise = (Int -> Int
forall a. Enum a => a -> a
succ Int
i, UArray Int Int
unassignedPorts UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
i)

-- | Attempt to connect to the given host/port.
getSocketUDP :: String -> Int -> IO (Socket, AddrInfo)
getSocketUDP :: String -> Int -> IO (Socket, AddrInfo)
getSocketUDP = SocketType -> String -> Int -> IO (Socket, AddrInfo)
getSocketGen SocketType
NS.Datagram

-- | Attempt to bind a listening @Socket@ on the given host/port. If no host is
-- given, will use the first address available.
bindPortUDP :: Int -> HostPreference -> IO Socket
bindPortUDP :: Int -> HostPreference -> IO Socket
bindPortUDP = SocketType -> Int -> HostPreference -> IO Socket
bindPortGen SocketType
NS.Datagram

-- | Bind a random UDP port.
--
-- See 'bindRandomPortGen'
--
-- Since 0.1.1
bindRandomPortUDP :: HostPreference -> IO (Int, Socket)
bindRandomPortUDP :: HostPreference -> IO (Int, Socket)
bindRandomPortUDP = SocketType -> HostPreference -> IO (Int, Socket)
bindRandomPortGen SocketType
NS.Datagram

{-# NOINLINE defaultReadBufferSize #-}
defaultReadBufferSize :: Int
defaultReadBufferSize :: Int
defaultReadBufferSize = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
  IO Socket -> (Socket -> IO ()) -> (Socket -> IO Int) -> IO Int
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket Family
NS.AF_INET SocketType
NS.Stream ProtocolNumber
0) Socket -> IO ()
NS.close (\Socket
sock -> Socket -> SocketOption -> IO Int
NS.getSocketOption Socket
sock SocketOption
NS.RecvBuffer)

#if !WINDOWS
-- | Attempt to connect to the given Unix domain socket path.
getSocketUnix :: FilePath -> IO Socket
getSocketUnix :: String -> IO Socket
getSocketUnix String
path = do
    Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket Family
NS.AF_UNIX SocketType
NS.Stream ProtocolNumber
0
    Either SomeException ()
ee <- IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
try' (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
NS.connect Socket
sock (String -> SockAddr
NS.SockAddrUnix String
path)
    case Either SomeException ()
ee of
        Left SomeException
e -> Socket -> IO ()
NS.close Socket
sock IO () -> IO Socket -> IO Socket
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO Socket
forall e a. Exception e => e -> IO a
throwIO SomeException
e
        Right () -> Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
  where
    try' :: IO a -> IO (Either SomeException a)
    try' :: IO a -> IO (Either SomeException a)
try' = IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try

-- | Attempt to bind a listening Unix domain socket at the given path.
bindPath :: FilePath -> IO Socket
bindPath :: String -> IO Socket
bindPath String
path = do
  Socket
sock <- IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
            (Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket Family
NS.AF_UNIX SocketType
NS.Stream ProtocolNumber
0)
            Socket -> IO ()
NS.close
            (\Socket
sock -> do
                String -> IO ()
removeFileSafe String
path  -- Cannot bind if the socket file exists.
                Socket -> SockAddr -> IO ()
NS.bind Socket
sock (String -> SockAddr
NS.SockAddrUnix String
path)
                Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock)
  Socket -> Int -> IO ()
NS.listen Socket
sock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
  Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

removeFileSafe :: FilePath -> IO ()
removeFileSafe :: String -> IO ()
removeFileSafe String
path =
    String -> IO ()
removeFile String
path IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` IOException -> IO ()
handleExists
  where
    handleExists :: IOException -> IO ()
handleExists IOException
e
          | IOException -> Bool
isDoesNotExistError IOException
e = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise = IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e

-- | Smart constructor.
serverSettingsUnix
    :: FilePath -- ^ path to bind to
    -> ServerSettingsUnix
serverSettingsUnix :: String -> ServerSettingsUnix
serverSettingsUnix String
path = ServerSettingsUnix :: String -> (Socket -> IO ()) -> Int -> ServerSettingsUnix
ServerSettingsUnix
    { serverPath :: String
serverPath = String
path
    , serverAfterBindUnix :: Socket -> IO ()
serverAfterBindUnix = IO () -> Socket -> IO ()
forall a b. a -> b -> a
const (IO () -> Socket -> IO ()) -> IO () -> Socket -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , serverReadBufferSizeUnix :: Int
serverReadBufferSizeUnix = Int
defaultReadBufferSize
    }

-- | Smart constructor.
clientSettingsUnix
    :: FilePath -- ^ path to connect to
    -> ClientSettingsUnix
clientSettingsUnix :: String -> ClientSettingsUnix
clientSettingsUnix String
path = ClientSettingsUnix :: String -> Int -> ClientSettingsUnix
ClientSettingsUnix
    { clientPath :: String
clientPath = String
path
    , clientReadBufferSizeUnix :: Int
clientReadBufferSizeUnix = Int
defaultReadBufferSize
    }
#endif

#if defined(__GLASGOW_HASKELL__) && WINDOWS
-- Socket recv and accept calls on Windows platform cannot be interrupted when compiled with -threaded.
-- See https://ghc.haskell.org/trac/ghc/ticket/5797 for details.
-- The following enables simple workaround
#define SOCKET_ACCEPT_RECV_WORKAROUND
#endif

safeRecv :: Socket -> Int -> IO ByteString
#ifndef SOCKET_ACCEPT_RECV_WORKAROUND
safeRecv :: Socket -> Int -> IO ByteString
safeRecv = Socket -> Int -> IO ByteString
recv
#else
safeRecv s buf = do
    var <- newEmptyMVar
    forkIO $ recv s buf `E.catch` (\(_::IOException) -> return S8.empty) >>= putMVar var
    takeMVar var
#endif

-- | Smart constructor.
serverSettingsUDP
    :: Int -- ^ port to bind to
    -> HostPreference -- ^ host binding preferences
    -> ServerSettings
serverSettingsUDP :: Int -> HostPreference -> ServerSettings
serverSettingsUDP = Int -> HostPreference -> ServerSettings
serverSettingsTCP

-- | Smart constructor.
serverSettingsTCP
    :: Int -- ^ port to bind to
    -> HostPreference -- ^ host binding preferences
    -> ServerSettings
serverSettingsTCP :: Int -> HostPreference -> ServerSettings
serverSettingsTCP Int
port HostPreference
host = ServerSettings :: Int
-> HostPreference
-> Maybe Socket
-> (Socket -> IO ())
-> Bool
-> Int
-> ServerSettings
ServerSettings
    { serverPort :: Int
serverPort = Int
port
    , serverHost :: HostPreference
serverHost = HostPreference
host
    , serverSocket :: Maybe Socket
serverSocket = Maybe Socket
forall a. Maybe a
Nothing
    , serverAfterBind :: Socket -> IO ()
serverAfterBind = IO () -> Socket -> IO ()
forall a b. a -> b -> a
const (IO () -> Socket -> IO ()) -> IO () -> Socket -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , serverNeedLocalAddr :: Bool
serverNeedLocalAddr = Bool
False
    , serverReadBufferSize :: Int
serverReadBufferSize = Int
defaultReadBufferSize
    }

-- | Create a server settings that uses an already available listening socket.
-- Any port and host modifications made to this value will be ignored.
--
-- Since 0.1.1
serverSettingsTCPSocket :: Socket -> ServerSettings
serverSettingsTCPSocket :: Socket -> ServerSettings
serverSettingsTCPSocket Socket
lsocket = ServerSettings :: Int
-> HostPreference
-> Maybe Socket
-> (Socket -> IO ())
-> Bool
-> Int
-> ServerSettings
ServerSettings
    { serverPort :: Int
serverPort = Int
0
    , serverHost :: HostPreference
serverHost = HostPreference
HostAny
    , serverSocket :: Maybe Socket
serverSocket = Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
lsocket
    , serverAfterBind :: Socket -> IO ()
serverAfterBind = IO () -> Socket -> IO ()
forall a b. a -> b -> a
const (IO () -> Socket -> IO ()) -> IO () -> Socket -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , serverNeedLocalAddr :: Bool
serverNeedLocalAddr = Bool
False
    , serverReadBufferSize :: Int
serverReadBufferSize = Int
defaultReadBufferSize
    }

-- | Smart constructor.
clientSettingsUDP
    :: Int -- ^ port to connect to
    -> ByteString -- ^ host to connect to
    -> ClientSettings
clientSettingsUDP :: Int -> ByteString -> ClientSettings
clientSettingsUDP = Int -> ByteString -> ClientSettings
clientSettingsTCP

-- | Smart constructor.
clientSettingsTCP
    :: Int -- ^ port to connect to
    -> ByteString -- ^ host to connect to
    -> ClientSettings
clientSettingsTCP :: Int -> ByteString -> ClientSettings
clientSettingsTCP Int
port ByteString
host = ClientSettings :: Int -> ByteString -> Family -> Int -> ClientSettings
ClientSettings
    { clientPort :: Int
clientPort = Int
port
    , clientHost :: ByteString
clientHost = ByteString
host
    , clientAddrFamily :: Family
clientAddrFamily = Family
NS.AF_UNSPEC
    , clientReadBufferSize :: Int
clientReadBufferSize = Int
defaultReadBufferSize
    }

-- | Attempt to connect to the given host/port/address family.
--
-- Since 0.1.3
getSocketFamilyTCP :: ByteString -> Int -> NS.Family -> IO (NS.Socket, NS.SockAddr)
getSocketFamilyTCP :: ByteString -> Int -> Family -> IO (Socket, SockAddr)
getSocketFamilyTCP ByteString
host' Int
port' Family
addrFamily = do
    [AddrInfo]
addrsInfo <- SocketType -> String -> Int -> Family -> IO [AddrInfo]
getPossibleAddrs SocketType
NS.Stream (ByteString -> String
S8.unpack ByteString
host') Int
port' Family
addrFamily
    [AddrInfo] -> IO (Socket, SockAddr)
firstSuccess [AddrInfo]
addrsInfo
  where
    firstSuccess :: [AddrInfo] -> IO (Socket, SockAddr)
firstSuccess [AddrInfo
ai]     = AddrInfo -> IO (Socket, SockAddr)
connect AddrInfo
ai
    firstSuccess (AddrInfo
ai:[AddrInfo]
ais) = AddrInfo -> IO (Socket, SockAddr)
connect AddrInfo
ai IO (Socket, SockAddr)
-> (IOException -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_ :: IOException) -> [AddrInfo] -> IO (Socket, SockAddr)
firstSuccess [AddrInfo]
ais
    firstSuccess [AddrInfo]
_        = String -> IO (Socket, SockAddr)
forall a. HasCallStack => String -> a
error String
"getSocketFamilyTCP: can't happen"

    createSocket :: AddrInfo -> IO Socket
createSocket AddrInfo
addrInfo = do
        Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket (AddrInfo -> Family
NS.addrFamily AddrInfo
addrInfo) (AddrInfo -> SocketType
NS.addrSocketType AddrInfo
addrInfo)
                          (AddrInfo -> ProtocolNumber
NS.addrProtocol AddrInfo
addrInfo)
        Socket -> SocketOption -> Int -> IO ()
NS.setSocketOption Socket
sock SocketOption
NS.NoDelay Int
1
        Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

    connect :: AddrInfo -> IO (Socket, SockAddr)
connect AddrInfo
addrInfo = IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (Socket, SockAddr))
-> IO (Socket, SockAddr)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (AddrInfo -> IO Socket
createSocket AddrInfo
addrInfo) Socket -> IO ()
NS.close ((Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr))
-> (Socket -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
        Socket -> SockAddr -> IO ()
NS.connect Socket
sock (AddrInfo -> SockAddr
NS.addrAddress AddrInfo
addrInfo)
        (Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo -> SockAddr
NS.addrAddress AddrInfo
addrInfo)

-- | Attempt to connect to the given host/port.
getSocketTCP :: ByteString -> Int -> IO (NS.Socket, NS.SockAddr)
getSocketTCP :: ByteString -> Int -> IO (Socket, SockAddr)
getSocketTCP ByteString
host Int
port = ByteString -> Int -> Family -> IO (Socket, SockAddr)
getSocketFamilyTCP ByteString
host Int
port Family
NS.AF_UNSPEC

-- | Attempt to bind a listening @Socket@ on the given host/port. If no host is
-- given, will use the first address available.
-- 'maxListenQueue' is topically 128 which is too short for
-- high performance servers. So, we specify 'max 2048 maxListenQueue' to
-- the listen queue.
bindPortTCP :: Int -> HostPreference -> IO Socket
bindPortTCP :: Int -> HostPreference -> IO Socket
bindPortTCP Int
p HostPreference
s = do
    Socket
sock <- SocketType -> Int -> HostPreference -> IO Socket
bindPortGen SocketType
NS.Stream Int
p HostPreference
s
    Socket -> Int -> IO ()
NS.listen Socket
sock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
    Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

-- | Bind a random TCP port.
--
-- See 'bindRandomPortGen'.
--
-- Since 0.1.1
bindRandomPortTCP :: HostPreference -> IO (Int, Socket)
bindRandomPortTCP :: HostPreference -> IO (Int, Socket)
bindRandomPortTCP HostPreference
s = do
    (Int
port, Socket
sock) <- SocketType -> HostPreference -> IO (Int, Socket)
bindRandomPortGen SocketType
NS.Stream HostPreference
s
    Socket -> Int -> IO ()
NS.listen Socket
sock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
    (Int, Socket) -> IO (Int, Socket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
port, Socket
sock)

-- | Try to accept a connection, recovering automatically from exceptions.
--
-- As reported by Kazu against Warp, "resource exhausted (Too many open files)"
-- may be thrown by accept(). This function will catch that exception, wait a
-- second, and then try again.
acceptSafe :: Socket -> IO (Socket, NS.SockAddr)
acceptSafe :: Socket -> IO (Socket, SockAddr)
acceptSafe Socket
socket =
#ifndef SOCKET_ACCEPT_RECV_WORKAROUND
    IO (Socket, SockAddr)
loop
#else
    do var <- newEmptyMVar
       forkIO $ loop >>= putMVar var
       takeMVar var
#endif
  where
    loop :: IO (Socket, SockAddr)
loop =
        Socket -> IO (Socket, SockAddr)
NS.accept Socket
socket IO (Socket, SockAddr)
-> (IOException -> IO (Socket, SockAddr)) -> IO (Socket, SockAddr)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \IOException
e ->
            if IOErrorType -> Bool
isFullErrorType (IOException -> IOErrorType
ioeGetErrorType IOException
e)
                then do
                    Int -> IO ()
threadDelay Int
1000000
                    IO (Socket, SockAddr)
loop
                else IOException -> IO (Socket, SockAddr)
forall e a. Exception e => e -> IO a
E.throwIO IOException
e

message :: ByteString -> NS.SockAddr -> Message
message :: ByteString -> SockAddr -> Message
message = ByteString -> SockAddr -> Message
Message

class HasPort a where
    portLens :: Functor f => (Int -> f Int) -> a -> f a
instance HasPort ServerSettings where
    portLens :: (Int -> f Int) -> ServerSettings -> f ServerSettings
portLens Int -> f Int
f ServerSettings
ss = (Int -> ServerSettings) -> f Int -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ServerSettings
ss { serverPort :: Int
serverPort = Int
p }) (Int -> f Int
f (ServerSettings -> Int
serverPort ServerSettings
ss))
instance HasPort ClientSettings where
    portLens :: (Int -> f Int) -> ClientSettings -> f ClientSettings
portLens Int -> f Int
f ClientSettings
ss = (Int -> ClientSettings) -> f Int -> f ClientSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ClientSettings
ss { clientPort :: Int
clientPort = Int
p }) (Int -> f Int
f (ClientSettings -> Int
clientPort ClientSettings
ss))

getPort :: HasPort a => a -> Int
getPort :: a -> Int
getPort = Constant Int a -> Int
forall a k (b :: k). Constant a b -> a
getConstant (Constant Int a -> Int) -> (a -> Constant Int a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Constant Int Int) -> a -> Constant Int a
forall a (f :: * -> *).
(HasPort a, Functor f) =>
(Int -> f Int) -> a -> f a
portLens Int -> Constant Int Int
forall k a (b :: k). a -> Constant a b
Constant

setPort :: HasPort a => Int -> a -> a
setPort :: Int -> a -> a
setPort Int
p = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> a -> Identity a
forall a (f :: * -> *).
(HasPort a, Functor f) =>
(Int -> f Int) -> a -> f a
portLens (Identity Int -> Int -> Identity Int
forall a b. a -> b -> a
const (Int -> Identity Int
forall a. a -> Identity a
Identity Int
p))

setHost :: ByteString -> ClientSettings -> ClientSettings
setHost :: ByteString -> ClientSettings -> ClientSettings
setHost ByteString
hp ClientSettings
ss = ClientSettings
ss { clientHost :: ByteString
clientHost = ByteString
hp }

getHost :: ClientSettings -> ByteString
getHost :: ClientSettings -> ByteString
getHost = ClientSettings -> ByteString
clientHost

-- | Set the address family for the given settings.
--
-- Since 0.1.3
setAddrFamily :: NS.Family -> ClientSettings -> ClientSettings
setAddrFamily :: Family -> ClientSettings -> ClientSettings
setAddrFamily Family
af ClientSettings
cs = ClientSettings
cs { clientAddrFamily :: Family
clientAddrFamily = Family
af }

-- | Get the address family for the given settings.
--
-- Since 0.1.3
getAddrFamily :: ClientSettings -> NS.Family
getAddrFamily :: ClientSettings -> Family
getAddrFamily = ClientSettings -> Family
clientAddrFamily

#if !WINDOWS
class HasPath a where
    pathLens :: Functor f => (FilePath -> f FilePath) -> a -> f a
instance HasPath ServerSettingsUnix where
    pathLens :: (String -> f String) -> ServerSettingsUnix -> f ServerSettingsUnix
pathLens String -> f String
f ServerSettingsUnix
ss = (String -> ServerSettingsUnix) -> f String -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
p -> ServerSettingsUnix
ss { serverPath :: String
serverPath = String
p }) (String -> f String
f (ServerSettingsUnix -> String
serverPath ServerSettingsUnix
ss))
instance HasPath ClientSettingsUnix where
    pathLens :: (String -> f String) -> ClientSettingsUnix -> f ClientSettingsUnix
pathLens String -> f String
f ClientSettingsUnix
ss = (String -> ClientSettingsUnix) -> f String -> f ClientSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
p -> ClientSettingsUnix
ss { clientPath :: String
clientPath = String
p }) (String -> f String
f (ClientSettingsUnix -> String
clientPath ClientSettingsUnix
ss))

getPath :: HasPath a => a -> FilePath
getPath :: a -> String
getPath = Constant String a -> String
forall a k (b :: k). Constant a b -> a
getConstant (Constant String a -> String)
-> (a -> Constant String a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Constant String String) -> a -> Constant String a
forall a (f :: * -> *).
(HasPath a, Functor f) =>
(String -> f String) -> a -> f a
pathLens String -> Constant String String
forall k a (b :: k). a -> Constant a b
Constant

setPath :: HasPath a => FilePath -> a -> a
setPath :: String -> a -> a
setPath String
p = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Identity String) -> a -> Identity a
forall a (f :: * -> *).
(HasPath a, Functor f) =>
(String -> f String) -> a -> f a
pathLens (Identity String -> String -> Identity String
forall a b. a -> b -> a
const (String -> Identity String
forall a. a -> Identity a
Identity String
p))
#endif

setNeedLocalAddr :: Bool -> ServerSettings -> ServerSettings
setNeedLocalAddr :: Bool -> ServerSettings -> ServerSettings
setNeedLocalAddr Bool
x ServerSettings
y = ServerSettings
y { serverNeedLocalAddr :: Bool
serverNeedLocalAddr = Bool
x }

getNeedLocalAddr :: ServerSettings -> Bool
getNeedLocalAddr :: ServerSettings -> Bool
getNeedLocalAddr = ServerSettings -> Bool
serverNeedLocalAddr

class HasAfterBind a where
    afterBindLens :: Functor f => ((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
instance HasAfterBind ServerSettings where
    afterBindLens :: ((Socket -> IO ()) -> f (Socket -> IO ()))
-> ServerSettings -> f ServerSettings
afterBindLens (Socket -> IO ()) -> f (Socket -> IO ())
f ServerSettings
ss = ((Socket -> IO ()) -> ServerSettings)
-> f (Socket -> IO ()) -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Socket -> IO ()
p -> ServerSettings
ss { serverAfterBind :: Socket -> IO ()
serverAfterBind = Socket -> IO ()
p }) ((Socket -> IO ()) -> f (Socket -> IO ())
f (ServerSettings -> Socket -> IO ()
serverAfterBind ServerSettings
ss))
#if !WINDOWS
instance HasAfterBind ServerSettingsUnix where
    afterBindLens :: ((Socket -> IO ()) -> f (Socket -> IO ()))
-> ServerSettingsUnix -> f ServerSettingsUnix
afterBindLens (Socket -> IO ()) -> f (Socket -> IO ())
f ServerSettingsUnix
ss = ((Socket -> IO ()) -> ServerSettingsUnix)
-> f (Socket -> IO ()) -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Socket -> IO ()
p -> ServerSettingsUnix
ss { serverAfterBindUnix :: Socket -> IO ()
serverAfterBindUnix = Socket -> IO ()
p }) ((Socket -> IO ()) -> f (Socket -> IO ())
f (ServerSettingsUnix -> Socket -> IO ()
serverAfterBindUnix ServerSettingsUnix
ss))
#endif

getAfterBind :: HasAfterBind a => a -> (Socket -> IO ())
getAfterBind :: a -> Socket -> IO ()
getAfterBind = Constant (Socket -> IO ()) a -> Socket -> IO ()
forall a k (b :: k). Constant a b -> a
getConstant (Constant (Socket -> IO ()) a -> Socket -> IO ())
-> (a -> Constant (Socket -> IO ()) a) -> a -> Socket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Socket -> IO ()) -> Constant (Socket -> IO ()) (Socket -> IO ()))
-> a -> Constant (Socket -> IO ()) a
forall a (f :: * -> *).
(HasAfterBind a, Functor f) =>
((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
afterBindLens (Socket -> IO ()) -> Constant (Socket -> IO ()) (Socket -> IO ())
forall k a (b :: k). a -> Constant a b
Constant

setAfterBind :: HasAfterBind a => (Socket -> IO ()) -> a -> a
setAfterBind :: (Socket -> IO ()) -> a -> a
setAfterBind Socket -> IO ()
p = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Socket -> IO ()) -> Identity (Socket -> IO ()))
-> a -> Identity a
forall a (f :: * -> *).
(HasAfterBind a, Functor f) =>
((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
afterBindLens (Identity (Socket -> IO ())
-> (Socket -> IO ()) -> Identity (Socket -> IO ())
forall a b. a -> b -> a
const ((Socket -> IO ()) -> Identity (Socket -> IO ())
forall a. a -> Identity a
Identity Socket -> IO ()
p))

-- | Since 0.1.13
class HasReadBufferSize a where
    readBufferSizeLens :: Functor f => (Int -> f Int) -> a -> f a
-- | Since 0.1.13
instance HasReadBufferSize ServerSettings where
    readBufferSizeLens :: (Int -> f Int) -> ServerSettings -> f ServerSettings
readBufferSizeLens Int -> f Int
f ServerSettings
ss = (Int -> ServerSettings) -> f Int -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ServerSettings
ss { serverReadBufferSize :: Int
serverReadBufferSize = Int
p }) (Int -> f Int
f (ServerSettings -> Int
serverReadBufferSize ServerSettings
ss))
-- | Since 0.1.13
instance HasReadBufferSize ClientSettings where
    readBufferSizeLens :: (Int -> f Int) -> ClientSettings -> f ClientSettings
readBufferSizeLens Int -> f Int
f ClientSettings
cs = (Int -> ClientSettings) -> f Int -> f ClientSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ClientSettings
cs { clientReadBufferSize :: Int
clientReadBufferSize = Int
p }) (Int -> f Int
f (ClientSettings -> Int
clientReadBufferSize ClientSettings
cs))
#if !WINDOWS
-- | Since 0.1.13
instance HasReadBufferSize ServerSettingsUnix where
    readBufferSizeLens :: (Int -> f Int) -> ServerSettingsUnix -> f ServerSettingsUnix
readBufferSizeLens Int -> f Int
f ServerSettingsUnix
ss = (Int -> ServerSettingsUnix) -> f Int -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ServerSettingsUnix
ss { serverReadBufferSizeUnix :: Int
serverReadBufferSizeUnix = Int
p }) (Int -> f Int
f (ServerSettingsUnix -> Int
serverReadBufferSizeUnix ServerSettingsUnix
ss))
-- | Since 0.1.14
instance HasReadBufferSize ClientSettingsUnix where
    readBufferSizeLens :: (Int -> f Int) -> ClientSettingsUnix -> f ClientSettingsUnix
readBufferSizeLens Int -> f Int
f ClientSettingsUnix
ss = (Int -> ClientSettingsUnix) -> f Int -> f ClientSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
p -> ClientSettingsUnix
ss { clientReadBufferSizeUnix :: Int
clientReadBufferSizeUnix = Int
p }) (Int -> f Int
f (ClientSettingsUnix -> Int
clientReadBufferSizeUnix ClientSettingsUnix
ss))
#endif

-- | Get buffer size used when reading from socket.
--
-- Since 0.1.13
getReadBufferSize :: HasReadBufferSize a => a -> Int
getReadBufferSize :: a -> Int
getReadBufferSize = Constant Int a -> Int
forall a k (b :: k). Constant a b -> a
getConstant (Constant Int a -> Int) -> (a -> Constant Int a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Constant Int Int) -> a -> Constant Int a
forall a (f :: * -> *).
(HasReadBufferSize a, Functor f) =>
(Int -> f Int) -> a -> f a
readBufferSizeLens Int -> Constant Int Int
forall k a (b :: k). a -> Constant a b
Constant

-- | Set buffer size used when reading from socket.
--
-- Since 0.1.13
setReadBufferSize :: HasReadBufferSize a => Int -> a -> a
setReadBufferSize :: Int -> a -> a
setReadBufferSize Int
p = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> a -> Identity a
forall a (f :: * -> *).
(HasReadBufferSize a, Functor f) =>
(Int -> f Int) -> a -> f a
readBufferSizeLens (Identity Int -> Int -> Identity Int
forall a b. a -> b -> a
const (Int -> Identity Int
forall a. a -> Identity a
Identity Int
p))

type ConnectionHandle = Socket -> NS.SockAddr -> Maybe NS.SockAddr -> IO ()

runTCPServerWithHandle :: ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle :: ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle (ServerSettings Int
port HostPreference
host Maybe Socket
msocket Socket -> IO ()
afterBind Bool
needLocalAddr Int
_) ConnectionHandle
handle =
    case Maybe Socket
msocket of
        Maybe Socket
Nothing -> 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 (Int -> HostPreference -> IO Socket
bindPortTCP Int
port HostPreference
host) Socket -> IO ()
NS.close Socket -> IO a
forall b. Socket -> IO b
inner
        Just Socket
lsocket -> Socket -> IO a
forall b. Socket -> IO b
inner Socket
lsocket
  where
    inner :: Socket -> IO b
inner Socket
lsocket = Socket -> IO ()
afterBind Socket
lsocket IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Socket -> IO ()
serve Socket
lsocket)
    serve :: Socket -> IO ()
serve Socket
lsocket = 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)
acceptSafe Socket
lsocket)
        (\(Socket
socket, SockAddr
_) -> Socket -> IO ()
NS.close Socket
socket)
        (((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Socket
socket, SockAddr
addr) -> do
            Maybe SockAddr
mlocal <- if Bool
needLocalAddr
                        then (SockAddr -> Maybe SockAddr) -> IO SockAddr -> IO (Maybe SockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SockAddr -> Maybe SockAddr
forall a. a -> Maybe a
Just (IO SockAddr -> IO (Maybe SockAddr))
-> IO SockAddr -> IO (Maybe SockAddr)
forall a b. (a -> b) -> a -> b
$ Socket -> IO SockAddr
NS.getSocketName Socket
socket
                        else Maybe SockAddr -> IO (Maybe SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SockAddr
forall a. Maybe a
Nothing
            ThreadId
_ <- ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> IO () -> IO ThreadId
forkIO
               (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
restore (ConnectionHandle
handle Socket
socket SockAddr
addr Maybe SockAddr
mlocal)
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`E.finally` Socket -> IO ()
NS.close Socket
socket
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()



-- | Run an @Application@ with the given settings. This function will create a
-- new listening socket, accept connections on it, and spawn a new thread for
-- each connection.
runTCPServer :: ServerSettings -> (AppData -> IO ()) -> IO a
runTCPServer :: ServerSettings -> (AppData -> IO ()) -> IO a
runTCPServer ServerSettings
settings AppData -> IO ()
app = ServerSettings -> ConnectionHandle -> IO a
forall a. ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle ServerSettings
settings ConnectionHandle
app'
  where app' :: ConnectionHandle
app' Socket
socket SockAddr
addr Maybe SockAddr
mlocal =
          let ad :: AppData
ad = AppData :: IO ByteString
-> (ByteString -> IO ())
-> SockAddr
-> Maybe SockAddr
-> IO ()
-> Maybe Socket
-> AppData
AppData
                { appRead' :: IO ByteString
appRead' = Socket -> Int -> IO ByteString
safeRecv Socket
socket (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ServerSettings -> Int
forall a. HasReadBufferSize a => a -> Int
getReadBufferSize ServerSettings
settings
                , appWrite' :: ByteString -> IO ()
appWrite' = Socket -> ByteString -> IO ()
sendAll Socket
socket
                , appSockAddr' :: SockAddr
appSockAddr' = SockAddr
addr
                , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
mlocal
                , appCloseConnection' :: IO ()
appCloseConnection' = Socket -> IO ()
NS.close Socket
socket
                , appRawSocket' :: Maybe Socket
appRawSocket' = Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
socket
                }
          in
            AppData -> IO ()
app AppData
ad

-- | Run an @Application@ by connecting to the specified server.
runTCPClient :: ClientSettings -> (AppData -> IO a) -> IO a
runTCPClient :: ClientSettings -> (AppData -> IO a) -> IO a
runTCPClient (ClientSettings Int
port ByteString
host Family
addrFamily Int
readBufferSize) AppData -> IO a
app = IO (Socket, SockAddr)
-> ((Socket, SockAddr) -> IO ())
-> ((Socket, SockAddr) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
    (ByteString -> Int -> Family -> IO (Socket, SockAddr)
getSocketFamilyTCP ByteString
host Int
port Family
addrFamily)
    (Socket -> IO ()
NS.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
s, SockAddr
address) -> AppData -> IO a
app AppData :: IO ByteString
-> (ByteString -> IO ())
-> SockAddr
-> Maybe SockAddr
-> IO ()
-> Maybe Socket
-> AppData
AppData
        { appRead' :: IO ByteString
appRead' = Socket -> Int -> IO ByteString
safeRecv Socket
s Int
readBufferSize
        , appWrite' :: ByteString -> IO ()
appWrite' = Socket -> ByteString -> IO ()
sendAll Socket
s
        , appSockAddr' :: SockAddr
appSockAddr' = SockAddr
address
        , appLocalAddr' :: Maybe SockAddr
appLocalAddr' = Maybe SockAddr
forall a. Maybe a
Nothing
        , appCloseConnection' :: IO ()
appCloseConnection' = Socket -> IO ()
NS.close Socket
s
        , appRawSocket' :: Maybe Socket
appRawSocket' = Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
s
        })

appLocalAddr :: AppData -> Maybe NS.SockAddr
appLocalAddr :: AppData -> Maybe SockAddr
appLocalAddr = AppData -> Maybe SockAddr
appLocalAddr'

appSockAddr :: AppData -> NS.SockAddr
appSockAddr :: AppData -> SockAddr
appSockAddr = AppData -> SockAddr
appSockAddr'

-- | Close the underlying connection. One possible use case is simulating
-- connection failures in a test suite.
--
-- Since 0.1.6
appCloseConnection :: AppData -> IO ()
appCloseConnection :: AppData -> IO ()
appCloseConnection = AppData -> IO ()
appCloseConnection'

-- | Get the raw socket for this @AppData@, if available.
--
-- Since 0.1.12
appRawSocket :: AppData -> Maybe NS.Socket
appRawSocket :: AppData -> Maybe Socket
appRawSocket = AppData -> Maybe Socket
appRawSocket'

class HasReadWrite a where
    readLens :: Functor f => (IO ByteString -> f (IO ByteString)) -> a -> f a
    writeLens :: Functor f => ((ByteString -> IO ()) -> f (ByteString -> IO ())) -> a -> f a
instance HasReadWrite AppData where
    readLens :: (IO ByteString -> f (IO ByteString)) -> AppData -> f AppData
readLens IO ByteString -> f (IO ByteString)
f AppData
a = (IO ByteString -> AppData) -> f (IO ByteString) -> f AppData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO ByteString
x -> AppData
a { appRead' :: IO ByteString
appRead' = IO ByteString
x }) (IO ByteString -> f (IO ByteString)
f (AppData -> IO ByteString
appRead' AppData
a))
    writeLens :: ((ByteString -> IO ()) -> f (ByteString -> IO ()))
-> AppData -> f AppData
writeLens (ByteString -> IO ()) -> f (ByteString -> IO ())
f AppData
a = ((ByteString -> IO ()) -> AppData)
-> f (ByteString -> IO ()) -> f AppData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString -> IO ()
x -> AppData
a { appWrite' :: ByteString -> IO ()
appWrite' = ByteString -> IO ()
x }) ((ByteString -> IO ()) -> f (ByteString -> IO ())
f (AppData -> ByteString -> IO ()
appWrite' AppData
a))
#if !WINDOWS
instance HasReadWrite AppDataUnix where
    readLens :: (IO ByteString -> f (IO ByteString))
-> AppDataUnix -> f AppDataUnix
readLens IO ByteString -> f (IO ByteString)
f AppDataUnix
a = (IO ByteString -> AppDataUnix)
-> f (IO ByteString) -> f AppDataUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO ByteString
x -> AppDataUnix
a { appReadUnix :: IO ByteString
appReadUnix = IO ByteString
x }) (IO ByteString -> f (IO ByteString)
f (AppDataUnix -> IO ByteString
appReadUnix AppDataUnix
a))
    writeLens :: ((ByteString -> IO ()) -> f (ByteString -> IO ()))
-> AppDataUnix -> f AppDataUnix
writeLens (ByteString -> IO ()) -> f (ByteString -> IO ())
f AppDataUnix
a = ((ByteString -> IO ()) -> AppDataUnix)
-> f (ByteString -> IO ()) -> f AppDataUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString -> IO ()
x -> AppDataUnix
a { appWriteUnix :: ByteString -> IO ()
appWriteUnix = ByteString -> IO ()
x }) ((ByteString -> IO ()) -> f (ByteString -> IO ())
f (AppDataUnix -> ByteString -> IO ()
appWriteUnix AppDataUnix
a))
#endif

appRead :: HasReadWrite a => a -> IO ByteString
appRead :: a -> IO ByteString
appRead = Constant (IO ByteString) a -> IO ByteString
forall a k (b :: k). Constant a b -> a
getConstant (Constant (IO ByteString) a -> IO ByteString)
-> (a -> Constant (IO ByteString) a) -> a -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO ByteString -> Constant (IO ByteString) (IO ByteString))
-> a -> Constant (IO ByteString) a
forall a (f :: * -> *).
(HasReadWrite a, Functor f) =>
(IO ByteString -> f (IO ByteString)) -> a -> f a
readLens IO ByteString -> Constant (IO ByteString) (IO ByteString)
forall k a (b :: k). a -> Constant a b
Constant

appWrite :: HasReadWrite a => a -> ByteString -> IO ()
appWrite :: a -> ByteString -> IO ()
appWrite = Constant (ByteString -> IO ()) a -> ByteString -> IO ()
forall a k (b :: k). Constant a b -> a
getConstant (Constant (ByteString -> IO ()) a -> ByteString -> IO ())
-> (a -> Constant (ByteString -> IO ()) a)
-> a
-> ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> IO ())
 -> Constant (ByteString -> IO ()) (ByteString -> IO ()))
-> a -> Constant (ByteString -> IO ()) a
forall a (f :: * -> *).
(HasReadWrite a, Functor f) =>
((ByteString -> IO ()) -> f (ByteString -> IO ())) -> a -> f a
writeLens (ByteString -> IO ())
-> Constant (ByteString -> IO ()) (ByteString -> IO ())
forall k a (b :: k). a -> Constant a b
Constant

#if !WINDOWS
-- | Run an @Application@ with the given settings. This function will create a
-- new listening socket, accept connections on it, and spawn a new thread for
-- each connection.
runUnixServer :: ServerSettingsUnix -> (AppDataUnix -> IO ()) -> IO a
runUnixServer :: ServerSettingsUnix -> (AppDataUnix -> IO ()) -> IO a
runUnixServer (ServerSettingsUnix String
path Socket -> IO ()
afterBind Int
readBufferSize) AppDataUnix -> IO ()
app = 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
    (String -> IO Socket
bindPath String
path)
    Socket -> IO ()
NS.close
    (\Socket
socket -> do
        Socket -> IO ()
afterBind Socket
socket
        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
$ Socket -> IO ()
serve Socket
socket)
  where
    serve :: Socket -> IO ()
serve Socket
lsocket = 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)
acceptSafe Socket
lsocket)
        (\(Socket
socket, SockAddr
_) -> Socket -> IO ()
NS.close Socket
socket)
        (((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Socket
socket, SockAddr
_) -> do
            let ad :: AppDataUnix
ad = AppDataUnix :: IO ByteString -> (ByteString -> IO ()) -> AppDataUnix
AppDataUnix
                    { appReadUnix :: IO ByteString
appReadUnix = Socket -> Int -> IO ByteString
safeRecv Socket
socket Int
readBufferSize
                    , appWriteUnix :: ByteString -> IO ()
appWriteUnix = Socket -> ByteString -> IO ()
sendAll Socket
socket
                    }
            ThreadId
_ <- ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> IO () -> IO ThreadId
forkIO
                (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
restore (AppDataUnix -> IO ()
app AppDataUnix
ad)
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`E.finally` Socket -> IO ()
NS.close Socket
socket
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Run an @Application@ by connecting to the specified server.
runUnixClient :: ClientSettingsUnix -> (AppDataUnix -> IO a) -> IO a
runUnixClient :: ClientSettingsUnix -> (AppDataUnix -> IO a) -> IO a
runUnixClient (ClientSettingsUnix String
path Int
readBufferSize) AppDataUnix -> IO a
app = 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
    (String -> IO Socket
getSocketUnix String
path)
    Socket -> IO ()
NS.close
    (\Socket
sock -> AppDataUnix -> IO a
app AppDataUnix :: IO ByteString -> (ByteString -> IO ()) -> AppDataUnix
AppDataUnix
        { appReadUnix :: IO ByteString
appReadUnix = Socket -> Int -> IO ByteString
safeRecv Socket
sock Int
readBufferSize
        , appWriteUnix :: ByteString -> IO ()
appWriteUnix = Socket -> ByteString -> IO ()
sendAll Socket
sock
        })
#endif