module Data.Conduit.Network.Unix
(
sourceSocket
, sinkSocket
, Application
, AppData
, appSource
, appSink
, ServerSettings
, serverSettings
, serverPath
, serverAfterBind
, runUnixServer
, ClientSettings
, clientSettings
, clientPath
, runUnixClient
, bindPath
, getSocket
, acceptSafe
) where
import Data.Conduit
import Network.Socket (Socket)
import qualified Network.Socket as NS
import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe)
import Data.Conduit.Network.Internal.Unix (AppData(..), ClientSettings(..), ServerSettings(..))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Exception (throwIO, SomeException, try, finally, bracket,
bracketOnError, catch)
import Control.Monad (forever, void)
import Control.Monad.Trans.Control (control)
import Control.Concurrent (forkIO)
import System.Directory (removeFile)
import System.IO.Error (isDoesNotExistError)
getSocket :: FilePath -> IO Socket
getSocket path = do
sock <- NS.socket NS.AF_UNIX NS.Stream 0
ee <- try' $ NS.connect sock (NS.SockAddrUnix path)
case ee of
Left e -> NS.sClose sock >> throwIO e
Right () -> return sock
where
try' :: IO a -> IO (Either SomeException a)
try' = try
bindPath :: FilePath -> IO Socket
bindPath path = do
sock <- bracketOnError
(NS.socket NS.AF_UNIX NS.Stream 0)
NS.sClose
(\sock -> do
removeFileSafe path
NS.bindSocket sock (NS.SockAddrUnix path)
return sock)
NS.listen sock (max 2048 NS.maxListenQueue)
return sock
removeFileSafe :: FilePath -> IO ()
removeFileSafe path =
removeFile path `Control.Exception.catch` handleExists
where
handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
type Application m = AppData m -> m ()
serverSettings :: Monad m
=> FilePath
-> ServerSettings m
serverSettings path = ServerSettings
{ serverPath = path
, serverAfterBind = const $ return ()
}
runUnixServer :: (MonadIO m, MonadBaseControl IO m) => ServerSettings m -> Application m -> m ()
runUnixServer (ServerSettings path afterBind) app = control $ \run -> bracket
(liftIO $ bindPath path)
(liftIO . NS.sClose)
(\socket -> run $ do
afterBind socket
forever $ serve socket)
where
serve lsocket = do
(socket, _) <- liftIO $ acceptSafe lsocket
let ad = AppData
{ appSource = sourceSocket socket
, appSink = sinkSocket socket
}
app' run = void $ run (app ad)
appClose run = app' run `finally` NS.sClose socket
control $ \run -> forkIO (appClose run) >> run (return ())
clientSettings :: Monad m
=> FilePath
-> ClientSettings m
clientSettings path = ClientSettings
{ clientPath = path
}
runUnixClient :: (MonadIO m, MonadBaseControl IO m) => ClientSettings m -> Application m -> m ()
runUnixClient (ClientSettings path) app = control $ \run -> bracket
(getSocket path)
NS.sClose
(\sock -> run $ app AppData
{ appSource = sourceSocket sock
, appSink = sinkSocket sock
})