{-# 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
sockettype host' :: String
host' port' :: Int
port' af :: 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 {
                addrFlags :: [AddrInfoFlag]
NS.addrFlags = [AddrInfoFlag
NS.AI_ADDRCONFIG]
              , 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
sockettype host' :: String
host' port' :: Int
port' af :: Family
af = do
    (addr :: AddrInfo
addr:_) <- 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
sockettype host :: String
host port :: 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
sockettype =
    case SocketType
sockettype of
        NS.Datagram -> [(SocketOption
NS.ReuseAddr,1)]
        _           -> [(SocketOption
NS.NoDelay,1), (SocketOption
NS.ReuseAddr,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
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 sockOpts :: [(SocketOption, Int)]
sockOpts sockettype :: SocketType
sockettype p :: Int
p s :: HostPreference
s = do
    let hints :: AddrInfo
hints = AddrInfo
NS.defaultHints
            { addrFlags :: [AddrInfoFlag]
NS.addrFlags = [ AddrInfoFlag
NS.AI_PASSIVE
                             , AddrInfoFlag
NS.AI_ADDRCONFIG
                             ]
            , addrSocketType :: SocketType
NS.addrSocketType = SocketType
sockettype
            }
        host :: Maybe String
host =
            case HostPreference
s of
                Host s' :: String
s' -> String -> Maybe String
forall a. a -> Maybe a
Just String
s'
                _ -> 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 (\x :: 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 (\x :: 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
                HostIPv4     -> [AddrInfo]
addrs4 [AddrInfo] -> [AddrInfo] -> [AddrInfo]
forall a. [a] -> [a] -> [a]
++ [AddrInfo]
addrs6
                HostIPv4Only -> [AddrInfo]
addrs4
                HostIPv6     -> [AddrInfo]
addrs6 [AddrInfo] -> [AddrInfo] -> [AddrInfo]
forall a. [a] -> [a] -> [a]
++ [AddrInfo]
addrs4
                HostIPv6Only -> [AddrInfo]
addrs6
                _ -> [AddrInfo]
addrs

        tryAddrs :: [AddrInfo] -> IO Socket
tryAddrs (addr1 :: AddrInfo
addr1:rest :: [AddrInfo]
rest@(_:_)) =
                                      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 (addr1 :: AddrInfo
addr1:[])         = AddrInfo -> IO Socket
theBody AddrInfo
addr1
        tryAddrs _                  = String -> IO Socket
forall a. HasCallStack => String -> a
error "bindPort: addrs is empty"

        theBody :: AddrInfo -> IO Socket
theBody addr :: 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
          (\sock :: 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_ (\(opt :: SocketOption
opt,v :: 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
sockettype s :: HostPreference
s = do
  Socket
socket <- SocketType -> Int -> HostPreference -> IO Socket
bindPortGen SocketType
sockettype 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
    [ [43124..44320]
    , [28120..29166]
    , [45967..46997]
    , [28241..29117]
    , [40001..40840]
    , [29170..29998]
    , [38866..39680]
    , [43442..44122]
    , [41122..41793]
    , [35358..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 = 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
- 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. Random a => (a, a) -> IO 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 i :: 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 0) Socket -> IO ()
NS.close (\sock :: 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 path :: String
path = do
    Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
NS.socket Family
NS.AF_UNIX SocketType
NS.Stream 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 e :: 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 path :: 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 0)
            Socket -> IO ()
NS.close
            (\sock :: 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 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 path :: 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 e :: 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 path :: String
path = $WServerSettingsUnix :: 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 path :: String
path = $WClientSettingsUnix :: 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 port :: Int
port host :: HostPreference
host = $WServerSettings :: 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 lsocket :: Socket
lsocket = $WServerSettings :: Int
-> HostPreference
-> Maybe Socket
-> (Socket -> IO ())
-> Bool
-> Int
-> ServerSettings
ServerSettings
    { serverPort :: Int
serverPort = 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 port :: Int
port host :: ByteString
host = $WClientSettings :: 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 host' :: ByteString
host' port' :: Int
port' addrFamily :: 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 [ai :: AddrInfo
ai]     = AddrInfo -> IO (Socket, SockAddr)
connect AddrInfo
ai
    firstSuccess (ai :: AddrInfo
ai:ais :: [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 _        = String -> IO (Socket, SockAddr)
forall a. HasCallStack => String -> a
error "getSocketFamilyTCP: can't happen"

    createSocket :: AddrInfo -> IO Socket
createSocket addrInfo :: 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 1
        Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

    connect :: AddrInfo -> IO (Socket, SockAddr)
connect addrInfo :: 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
$ \sock :: 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 host :: ByteString
host port :: 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 p :: Int
p s :: 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 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 s :: HostPreference
s = do
    (port :: Int
port, sock :: 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 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
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` \e :: IOException
e ->
            if IOErrorType -> Bool
isFullErrorType (IOException -> IOErrorType
ioeGetErrorType IOException
e)
                then do
                    Int -> IO ()
threadDelay 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 f :: Int -> f Int
f ss :: ServerSettings
ss = (Int -> ServerSettings) -> f Int -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: Int -> f Int
f ss :: ClientSettings
ss = (Int -> ClientSettings) -> f Int -> f ClientSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 p :: 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 hp :: ByteString
hp ss :: 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 af :: Family
af cs :: 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 f :: String -> f String
f ss :: ServerSettingsUnix
ss = (String -> ServerSettingsUnix) -> f String -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: String -> f String
f ss :: ClientSettingsUnix
ss = (String -> ClientSettingsUnix) -> f String -> f ClientSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 p :: 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 x :: Bool
x y :: 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 f :: (Socket -> IO ()) -> f (Socket -> IO ())
f ss :: ServerSettings
ss = ((Socket -> IO ()) -> ServerSettings)
-> f (Socket -> IO ()) -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: (Socket -> IO ()) -> f (Socket -> IO ())
f ss :: ServerSettingsUnix
ss = ((Socket -> IO ()) -> ServerSettingsUnix)
-> f (Socket -> IO ()) -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 p :: 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 f :: Int -> f Int
f ss :: ServerSettings
ss = (Int -> ServerSettings) -> f Int -> f ServerSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: Int -> f Int
f cs :: ClientSettings
cs = (Int -> ClientSettings) -> f Int -> f ClientSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: Int -> f Int
f ss :: ServerSettingsUnix
ss = (Int -> ServerSettingsUnix) -> f Int -> f ServerSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 f :: Int -> f Int
f ss :: ClientSettingsUnix
ss = (Int -> ClientSettingsUnix) -> f Int -> f ClientSettingsUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p :: 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 p :: 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 port :: Int
port host :: HostPreference
host msocket :: Maybe Socket
msocket afterBind :: Socket -> IO ()
afterBind needLocalAddr :: Bool
needLocalAddr _) handle :: ConnectionHandle
handle =
    case Maybe Socket
msocket of
        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 lsocket :: Socket
lsocket -> Socket -> IO a
forall b. Socket -> IO b
inner Socket
lsocket
  where
    inner :: Socket -> IO b
inner lsocket :: 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 lsocket :: 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
socket, _) -> Socket -> IO ()
NS.close Socket
socket)
        (((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(socket :: Socket
socket, addr :: 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
$ \restore :: 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 settings :: ServerSettings
settings app :: AppData -> IO ()
app = ServerSettings -> ConnectionHandle -> IO a
forall a. ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle ServerSettings
settings ConnectionHandle
app'
  where app' :: ConnectionHandle
app' socket :: Socket
socket addr :: SockAddr
addr mlocal :: Maybe SockAddr
mlocal =
          let ad :: AppData
ad = $WAppData :: 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 port :: Int
port host :: ByteString
host addrFamily :: Family
addrFamily readBufferSize :: Int
readBufferSize) app :: 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)
    (\(s :: Socket
s, address :: SockAddr
address) -> AppData -> IO a
app $WAppData :: 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 f :: IO ByteString -> f (IO ByteString)
f a :: AppData
a = (IO ByteString -> AppData) -> f (IO ByteString) -> f AppData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: 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 f :: (ByteString -> IO ()) -> f (ByteString -> IO ())
f a :: AppData
a = ((ByteString -> IO ()) -> AppData)
-> f (ByteString -> IO ()) -> f AppData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: 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 f :: IO ByteString -> f (IO ByteString)
f a :: AppDataUnix
a = (IO ByteString -> AppDataUnix)
-> f (IO ByteString) -> f AppDataUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: 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 f :: (ByteString -> IO ()) -> f (ByteString -> IO ())
f a :: AppDataUnix
a = ((ByteString -> IO ()) -> AppDataUnix)
-> f (ByteString -> IO ()) -> f AppDataUnix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: 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 path :: String
path afterBind :: Socket -> IO ()
afterBind readBufferSize :: Int
readBufferSize) app :: 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
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 lsocket :: 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
socket, _) -> Socket -> IO ()
NS.close Socket
socket)
        (((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(socket :: Socket
socket, _) -> do
            let ad :: AppDataUnix
ad = $WAppDataUnix :: 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
$ \restore :: 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 path :: String
path readBufferSize :: Int
readBufferSize) app :: 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
    (\sock :: Socket
sock -> AppDataUnix -> IO a
app $WAppDataUnix :: 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