{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} -- | -- Module: $HEADER$ -- Description: Helper functions that aren't provided by streaming-commons. -- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) -- Portability: CPP, FlexibleContexts, NoImplicitPrelude -- -- Module defines helper functions that would be ideally provided by -- -- package and some wrappers with specialised type signatures. -- -- Internal packages are here to provide access to internal definitions for -- library writers, but they should not be used in application code. -- -- Preferably use qualified import, e.g.: -- -- > import qualified Data.ConnectionPool.Internal.Streaming as Internal -- -- This module doesn't neither depend on -- package nor -- any other module of this package, with notable exception of -- "Data.ConnectionPool.Internal.HandlerParams", and it shoud stay that way. -- This module uses CPP to get OS specific things right. Most importantly -- Windows doesn't support UNIX Sockets. -- -- Please, bear above in mind when doing modifications. module Data.ConnectionPool.Internal.Streaming ( -- * TCP acquireTcpClientConnection , runTcpApp , runTcpAppImpl , fromClientSettings #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. -- * Unix Socket , runUnixApp , runUnixAppImpl , fromClientSettingsUnix #endif -- !WINDOWS ) where import Data.Int (Int) import Data.Maybe (Maybe(Just)) import System.IO (IO) import Control.Monad.Trans.Control (MonadBaseControl) import Network.Socket (Socket, SockAddr, sClose) import Network.Socket.ByteString (sendAll) import Data.Default.Class (Default(def)) import Data.Streaming.Network ( getSocketFamilyTCP , safeRecv #if MIN_VERSION_streaming_commons(0,1,13) -- Until streaming-commons 0.1.13, read buffer size was fixed. , getReadBufferSize #endif ) import Data.Streaming.Network.Internal ( AppData(AppData) , ClientSettings(clientPort, clientHost, clientAddrFamily) #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. , AppDataUnix(AppDataUnix) #if MIN_VERSION_streaming_commons(0,1,13) -- Until streaming-commons 0.1.13, read buffer size was fixed. For some -- mistifying reason there is no -- -- instance HasReadBufferSize ClientSettingsUnix". , ClientSettingsUnix(clientReadBufferSizeUnix) #endif -- streaming-commons >= 0.1.13 #endif -- !WINDOWS ) import qualified Data.Streaming.Network.Internal as AppData ( AppData ( appLocalAddr' , appRead' , appSockAddr' , appWrite' #if MIN_VERSION_streaming_commons(0,1,6) , appCloseConnection' #endif #if MIN_VERSION_streaming_commons(0,1,12) , appRawSocket' #endif )) import Data.ConnectionPool.Internal.HandlerParams ( HandlerParams(_readBufferSize) ) #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. import qualified Data.Streaming.Network.Internal as AppDataUnix (AppDataUnix(appReadUnix, appWriteUnix)) #endif -- !WINDOWS -- | Wrapper for 'runTcpAppImpl' with a type signature that is more natural -- for implementing a TCP specific -- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'. runTcpApp :: MonadBaseControl IO m => Maybe SockAddr -> (AppData -> m r) -> HandlerParams -> Socket -> SockAddr -> m r runTcpApp localAddr app params sock addr = runTcpAppImpl localAddr sock addr bufSize app where bufSize = _readBufferSize params -- | Simplified 'Data.Streaming.Network.runTCPClient' and -- 'Data.Streaming.Network.runTCPServer' that provides only construction of -- 'AppData' and passing it to a callback function. runTcpAppImpl :: MonadBaseControl IO m => Maybe SockAddr -> Socket -> SockAddr -> Int -> (AppData -> m r) -> m r runTcpAppImpl localAddr sock addr bufSize app = app AppData { AppData.appRead' = safeRecv sock bufSize -- :: !(IO ByteString) , AppData.appWrite' = sendAll sock -- :: !(ByteString -> IO ()) , AppData.appSockAddr' = addr -- :: !SockAddr , AppData.appLocalAddr' = localAddr -- :: !(Maybe SockAddr) #if MIN_VERSION_streaming_commons(0,1,6) , AppData.appCloseConnection' = sClose sock -- :: !(IO ()) #endif #if MIN_VERSION_streaming_commons(0,1,12) , AppData.appRawSocket' = Just sock -- :: Maybe Socket #endif } -- | Wrapper for 'getSocketFamilyTCP' that takes 'ClientSettings' instead of -- individual parameters. acquireTcpClientConnection :: ClientSettings -> IO (Socket, SockAddr) acquireTcpClientConnection settings = getSocketFamilyTCP host port addrFamily where port = clientPort settings host = clientHost settings addrFamily = clientAddrFamily settings fromClientSettings :: ClientSettings -> HandlerParams fromClientSettings _tcpParams = def #if MIN_VERSION_streaming_commons(0,1,13) -- Until streaming-commons 0.1.13, read buffer size was fixed. { _readBufferSize = getReadBufferSize _tcpParams } #endif #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. -- | Wrapper for 'runUnixAppImpl' with a type signature that is more natural -- for implementing a UNIX Socket specific -- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'. runUnixApp :: MonadBaseControl IO m => (AppDataUnix -> m r) -> HandlerParams -> Socket -> () -> m r runUnixApp app params sock () = runUnixAppImpl sock bufSize app where bufSize = _readBufferSize params -- | Simplified 'Data.Streaming.Network.runUnixClient' and -- 'Data.Streaming.Network.runUnixServer' that provides only construction of -- 'AppDataUnix' and passing it to a callback function. runUnixAppImpl :: MonadBaseControl IO m => Socket -> Int -> (AppDataUnix -> m r) -> m r runUnixAppImpl sock bufSize app = app AppDataUnix { AppDataUnix.appReadUnix = safeRecv sock bufSize , AppDataUnix.appWriteUnix = sendAll sock } fromClientSettingsUnix :: ClientSettingsUnix -> HandlerParams fromClientSettingsUnix _unixParams = def #if MIN_VERSION_streaming_commons(0,1,13) -- Until streaming-commons 0.1.13, read buffer size was fixed. { _readBufferSize = clientReadBufferSizeUnix _unixParams } #endif -- streaming-commons >= 0.1.13 #endif -- !WINDOWS