{-# 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 (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
host') (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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)
    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' -> forall a. a -> Maybe a
Just String
s'
                HostPreference
_ -> forall a. Maybe a
Nothing
        port :: Maybe String
port = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
p
    [AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo (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 = forall a. (a -> Bool) -> [a] -> [a]
filter (\AddrInfo
x -> AddrInfo -> Family
NS.addrFamily AddrInfo
x forall a. Eq a => a -> a -> Bool
/= Family
NS.AF_INET6) [AddrInfo]
addrs
        addrs6 :: [AddrInfo]
addrs6 = forall a. (a -> Bool) -> [a] -> [a]
filter (\AddrInfo
x -> AddrInfo -> Family
NS.addrFamily AddrInfo
x forall a. Eq a => a -> a -> Bool
== Family
NS.AF_INET6) [AddrInfo]
addrs
        addrs' :: [AddrInfo]
addrs' =
            case HostPreference
s of
                HostPreference
HostIPv4     -> [AddrInfo]
addrs4 forall a. [a] -> [a] -> [a]
++ [AddrInfo]
addrs6
                HostPreference
HostIPv4Only -> [AddrInfo]
addrs4
                HostPreference
HostIPv6     -> [AddrInfo]
addrs6 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]
_)) =
                                      forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                                      (AddrInfo -> IO Socket
theBody AddrInfo
addr1)
                                      (\(IOError
_ :: IOException) -> [AddrInfo] -> IO Socket
tryAddrs [AddrInfo]
rest)
        tryAddrs (AddrInfo
addr1:[])         = AddrInfo -> IO Socket
theBody AddrInfo
addr1
        tryAddrs [AddrInfo]
_                  = forall a. HasCallStack => String -> a
error String
"bindPort: addrs is empty"

        theBody :: AddrInfo -> IO Socket
theBody AddrInfo
addr =
          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
              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)
              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
  forall (m :: * -> *) a. Monad m => a -> m a
return (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 = 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 = 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
unassignedPortsList forall a. Num a => a -> a -> a
- Int
1

nextUnusedPort :: IORef Int
nextUnusedPort :: IORef Int
nextUnusedPort = forall a. IO a -> a
unsafePerformIO
               forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
unassignedPortsMin, Int
unassignedPortsMax) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Int
nextUnusedPort Int -> (Int, Int)
go
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
port
  where
    go :: Int -> (Int, Int)
go Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
> Int
unassignedPortsMax = (forall a. Enum a => a -> a
succ Int
unassignedPortsMin, UArray Int Int
unassignedPorts forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
unassignedPortsMin)
        | Bool
otherwise = (forall a. Enum a => a -> a
succ Int
i, UArray Int Int
unassignedPorts 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  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 <- forall a. IO a -> IO (Either SomeException a)
try' 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e a. Exception e => e -> IO a
throwIO SomeException
e
        Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
  where
    try' :: IO a -> IO (Either SomeException a)
    try' :: forall a. IO a -> IO (Either SomeException a)
try' = 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 <- 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)
                forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock)
  Socket -> Int -> IO ()
NS.listen Socket
sock (forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
  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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` IOError -> IO ()
handleExists
  where
    handleExists :: IOError -> IO ()
handleExists IOError
e
          | IOError -> Bool
isDoesNotExistError IOError
e = forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Bool
otherwise = forall e a. Exception e => e -> IO a
throwIO IOError
e

-- | Smart constructor.
serverSettingsUnix
    :: FilePath -- ^ path to bind to
    -> ServerSettingsUnix
serverSettingsUnix :: String -> ServerSettingsUnix
serverSettingsUnix String
path = ServerSettingsUnix
    { serverPath :: String
serverPath = String
path
    , serverAfterBindUnix :: Socket -> IO ()
serverAfterBindUnix = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
    { 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
    { serverPort :: Int
serverPort = Int
port
    , serverHost :: HostPreference
serverHost = HostPreference
host
    , serverSocket :: Maybe Socket
serverSocket = forall a. Maybe a
Nothing
    , serverAfterBind :: Socket -> IO ()
serverAfterBind = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
    { serverPort :: Int
serverPort = Int
0
    , serverHost :: HostPreference
serverHost = HostPreference
HostAny
    , serverSocket :: Maybe Socket
serverSocket = forall a. a -> Maybe a
Just Socket
lsocket
    , serverAfterBind :: Socket -> IO ()
serverAfterBind = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
    { 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOError
_ :: IOException) -> [AddrInfo] -> IO (Socket, SockAddr)
firstSuccess [AddrInfo]
ais
    firstSuccess [AddrInfo]
_        = 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
        forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

    connect :: AddrInfo -> IO (Socket, SockAddr)
connect AddrInfo
addrInfo = 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 forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
        Socket -> SockAddr -> IO ()
NS.connect Socket
sock (AddrInfo -> SockAddr
NS.addrAddress AddrInfo
addrInfo)
        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 (forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
    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 (forall a. Ord a => a -> a -> a
max Int
2048 Int
NS.maxListenQueue)
    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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \IOError
e ->
            if IOErrorType -> Bool
isFullErrorType (IOError -> IOErrorType
ioeGetErrorType IOError
e)
                then do
                    Int -> IO ()
threadDelay Int
1000000
                    IO (Socket, SockAddr)
loop
                else forall e a. Exception e => e -> IO a
E.throwIO IOError
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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ServerSettings -> f ServerSettings
portLens Int -> f Int
f ServerSettings
ss = 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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ClientSettings -> f ClientSettings
portLens Int -> f Int
f ClientSettings
ss = 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 :: forall a. HasPort a => a -> Int
getPort = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasPort a, Functor f) =>
(Int -> f Int) -> a -> f a
portLens forall {k} a (b :: k). a -> Constant a b
Constant

setPort :: HasPort a => Int -> a -> a
setPort :: forall a. HasPort a => Int -> a -> a
setPort Int
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasPort a, Functor f) =>
(Int -> f Int) -> a -> f a
portLens (forall a b. a -> b -> a
const (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 :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> ServerSettingsUnix -> f ServerSettingsUnix
pathLens String -> f String
f ServerSettingsUnix
ss = 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 :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> ClientSettingsUnix -> f ClientSettingsUnix
pathLens String -> f String
f ClientSettingsUnix
ss = 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 :: forall a. HasPath a => a -> String
getPath = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasPath a, Functor f) =>
(String -> f String) -> a -> f a
pathLens forall {k} a (b :: k). a -> Constant a b
Constant

setPath :: HasPath a => FilePath -> a -> a
setPath :: forall a. HasPath a => String -> a -> a
setPath String
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasPath a, Functor f) =>
(String -> f String) -> a -> f a
pathLens (forall a b. a -> b -> a
const (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 :: forall (f :: * -> *).
Functor f =>
((Socket -> IO ()) -> f (Socket -> IO ()))
-> ServerSettings -> f ServerSettings
afterBindLens (Socket -> IO ()) -> f (Socket -> IO ())
f ServerSettings
ss = 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 :: forall (f :: * -> *).
Functor f =>
((Socket -> IO ()) -> f (Socket -> IO ()))
-> ServerSettingsUnix -> f ServerSettingsUnix
afterBindLens (Socket -> IO ()) -> f (Socket -> IO ())
f ServerSettingsUnix
ss = 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 :: forall a. HasAfterBind a => a -> Socket -> IO ()
getAfterBind = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasAfterBind a, Functor f) =>
((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
afterBindLens forall {k} a (b :: k). a -> Constant a b
Constant

setAfterBind :: HasAfterBind a => (Socket -> IO ()) -> a -> a
setAfterBind :: forall a. HasAfterBind a => (Socket -> IO ()) -> a -> a
setAfterBind Socket -> IO ()
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasAfterBind a, Functor f) =>
((Socket -> IO ()) -> f (Socket -> IO ())) -> a -> f a
afterBindLens (forall a b. a -> b -> a
const (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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ServerSettings -> f ServerSettings
readBufferSizeLens Int -> f Int
f ServerSettings
ss = 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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ClientSettings -> f ClientSettings
readBufferSizeLens Int -> f Int
f ClientSettings
cs = 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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ServerSettingsUnix -> f ServerSettingsUnix
readBufferSizeLens Int -> f Int
f ServerSettingsUnix
ss = 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 :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ClientSettingsUnix -> f ClientSettingsUnix
readBufferSizeLens Int -> f Int
f ClientSettingsUnix
ss = 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 :: forall a. HasReadBufferSize a => a -> Int
getReadBufferSize = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasReadBufferSize a, Functor f) =>
(Int -> f Int) -> a -> f a
readBufferSizeLens 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 :: forall a. HasReadBufferSize a => Int -> a -> a
setReadBufferSize Int
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasReadBufferSize a, Functor f) =>
(Int -> f Int) -> a -> f a
readBufferSizeLens (forall a b. a -> b -> a
const (forall a. a -> Identity a
Identity Int
p))

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

runTCPServerWithHandle :: ServerSettings -> ConnectionHandle -> IO a
runTCPServerWithHandle :: forall a. 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 -> 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 forall {b}. Socket -> IO b
inner
        Just Socket
lsocket -> forall {b}. Socket -> IO b
inner Socket
lsocket
  where
    inner :: Socket -> IO b
inner Socket
lsocket = Socket -> IO ()
afterBind Socket
lsocket forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Socket -> IO ()
serve Socket
lsocket)
    serve :: Socket -> IO ()
serve Socket
lsocket = 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)
        forall a b. (a -> b) -> a -> b
$ \(Socket
socket, SockAddr
addr) -> do
            Maybe SockAddr
mlocal <- if Bool
needLocalAddr
                        then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Socket -> IO SockAddr
NS.getSocketName Socket
socket
                        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            ThreadId
_ <- forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> IO () -> IO ThreadId
forkIO
               forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore (ConnectionHandle
handle Socket
socket SockAddr
addr Maybe SockAddr
mlocal)
                    forall a b. IO a -> IO b -> IO a
`E.finally` Socket -> IO ()
NS.close Socket
socket
            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 :: forall a. ServerSettings -> (AppData -> IO ()) -> IO a
runTCPServer ServerSettings
settings AppData -> IO ()
app = 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
                { appRead' :: IO ByteString
appRead' = Socket -> Int -> IO ByteString
safeRecv Socket
socket forall a b. (a -> b) -> a -> b
$ 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' = 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 :: forall a. ClientSettings -> (AppData -> IO a) -> IO a
runTCPClient (ClientSettings Int
port ByteString
host Family
addrFamily Int
readBufferSize) AppData -> IO a
app = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    (\(Socket
s, SockAddr
address) -> AppData -> IO a
app 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' = forall a. Maybe a
Nothing
        , appCloseConnection' :: IO ()
appCloseConnection' = Socket -> IO ()
NS.close Socket
s
        , appRawSocket' :: Maybe Socket
appRawSocket' = 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 :: forall (f :: * -> *).
Functor f =>
(IO ByteString -> f (IO ByteString)) -> AppData -> f AppData
readLens IO ByteString -> f (IO ByteString)
f AppData
a = 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 :: forall (f :: * -> *).
Functor f =>
((ByteString -> IO ()) -> f (ByteString -> IO ()))
-> AppData -> f AppData
writeLens (ByteString -> IO ()) -> f (ByteString -> IO ())
f AppData
a = 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 :: forall (f :: * -> *).
Functor f =>
(IO ByteString -> f (IO ByteString))
-> AppDataUnix -> f AppDataUnix
readLens IO ByteString -> f (IO ByteString)
f AppDataUnix
a = 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 :: forall (f :: * -> *).
Functor f =>
((ByteString -> IO ()) -> f (ByteString -> IO ()))
-> AppDataUnix -> f AppDataUnix
writeLens (ByteString -> IO ()) -> f (ByteString -> IO ())
f AppDataUnix
a = 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 :: forall a. HasReadWrite a => a -> IO ByteString
appRead = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasReadWrite a, Functor f) =>
(IO ByteString -> f (IO ByteString)) -> a -> f a
readLens forall {k} a (b :: k). a -> Constant a b
Constant

appWrite :: HasReadWrite a => a -> ByteString -> IO ()
appWrite :: forall a. HasReadWrite a => a -> ByteString -> IO ()
appWrite = forall {k} a (b :: k). Constant a b -> a
getConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(HasReadWrite a, Functor f) =>
((ByteString -> IO ()) -> f (ByteString -> IO ())) -> a -> f a
writeLens 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 :: forall a. ServerSettingsUnix -> (AppDataUnix -> IO ()) -> IO a
runUnixServer (ServerSettingsUnix String
path Socket -> IO ()
afterBind Int
readBufferSize) AppDataUnix -> IO ()
app = 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
        forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
serve Socket
socket)
  where
    serve :: Socket -> IO ()
serve Socket
lsocket = 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)
        forall a b. (a -> b) -> a -> b
$ \(Socket
socket, SockAddr
_) -> do
            let ad :: AppDataUnix
ad = 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 b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> IO () -> IO ThreadId
forkIO
                forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
restore (AppDataUnix -> IO ()
app AppDataUnix
ad)
                    forall a b. IO a -> IO b -> IO a
`E.finally` Socket -> IO ()
NS.close Socket
socket
            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 :: forall a. ClientSettingsUnix -> (AppDataUnix -> IO a) -> IO a
runUnixClient (ClientSettingsUnix String
path Int
readBufferSize) AppDataUnix -> IO a
app = 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
        { appReadUnix :: IO ByteString
appReadUnix = Socket -> Int -> IO ByteString
safeRecv Socket
sock Int
readBufferSize
        , appWriteUnix :: ByteString -> IO ()
appWriteUnix = Socket -> ByteString -> IO ()
sendAll Socket
sock
        })
#endif