module Data.Conduit.Network
(
sourceSocket
, sinkSocket
, Application
, ServerSettings (..)
, runTCPServer
, ClientSettings (..)
, runTCPClient
, HostPreference (..)
, bindPort
, getSocket
) where
import Data.Conduit
import qualified Network.Socket as NS
import Network.Socket (Socket)
import Network.Socket.ByteString (sendAll, recv)
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Exception (throwIO, SomeException, try, finally, bracket)
import Control.Monad (forever)
import Control.Monad.Trans.Control (MonadBaseControl, control)
import Control.Monad.Trans.Class (lift)
import Control.Concurrent (forkIO)
import Data.Conduit.Network.Utils (HostPreference)
import qualified Data.Conduit.Network.Utils as Utils
sourceSocket :: MonadIO m => Socket -> GSource m ByteString
sourceSocket socket =
loop
where
loop = do
bs <- lift $ liftIO $ recv socket 4096
if S.null bs
then return ()
else yield bs >> loop
sinkSocket :: MonadIO m => Socket -> GInfSink ByteString m
sinkSocket socket =
loop
where
loop = awaitE >>= either return (\bs -> lift (liftIO $ sendAll socket bs) >> loop)
type Application m = Source m ByteString
-> Sink ByteString m ()
-> m ()
data ServerSettings = ServerSettings
{ serverPort :: Int
, serverHost :: HostPreference
}
deriving (Eq, Show, Read)
runTCPServer :: (MonadIO m, MonadBaseControl IO m) => ServerSettings -> Application m -> m ()
runTCPServer (ServerSettings port host) app = control $ \run -> bracket
(liftIO $ bindPort port host)
(liftIO . NS.sClose)
(run . forever . serve)
where
serve lsocket = do
(socket, _addr) <- liftIO $ NS.accept lsocket
let src = sourceSocket socket
sink = sinkSocket socket
app' run = run (app src sink) >> return ()
appClose run = app' run `finally` NS.sClose socket
control $ \run -> forkIO (appClose run) >> run (return ())
data ClientSettings = ClientSettings
{ clientPort :: Int
, clientHost :: String
}
deriving (Eq, Show, Read)
runTCPClient :: (MonadIO m, MonadBaseControl IO m) => ClientSettings -> Application m -> m ()
runTCPClient (ClientSettings port host) app = control $ \run -> bracket
(getSocket host port)
NS.sClose
(\s -> run $ app (sourceSocket s) (sinkSocket s))
getSocket :: String -> Int -> IO NS.Socket
getSocket host' port' = do
(sock, addr) <- Utils.getSocket host' port' NS.Stream
ee <- try' $ NS.connect sock (NS.addrAddress addr)
case ee of
Left e -> NS.sClose sock >> throwIO e
Right () -> return sock
where
try' :: IO a -> IO (Either SomeException a)
try' = try
bindPort :: Int -> HostPreference -> IO Socket
bindPort p s = do
sock <- Utils.bindPort p s NS.Stream
NS.listen sock NS.maxListenQueue
return sock