module Network.BERT.Transport
(
Transport(..)
, Server(..)
, TransportM(..)
, SendPacketFn
, sendt, recvt, recvtForever
, TCP(..)
, tcpClient
, TCPServer(..)
, tcpServer
, resolve
) where
import Control.Monad
import Control.Applicative
import Control.Monad.Reader
import Network.Socket
import Data.Conduit
import Data.Conduit.Network
import Data.Conduit.Serialization.Binary
import Data.Void
import Data.BERT
type SendPacketFn = Packet -> IO ()
type TransportM = ReaderT SendPacketFn (ConduitM Packet Void IO)
class Transport t where
runSession :: t -> TransportM a -> IO a
closeConnection :: t -> IO ()
class Transport (ServerTransport s) => Server s where
type ServerTransport s
runServer :: s -> (ServerTransport s -> IO ()) -> IO ()
cleanup :: s -> IO ()
data TCP = TCP {
getTcpSocket :: !Socket
}
tcpSendPacketFn :: TCP -> SendPacketFn
tcpSendPacketFn (TCP sock) packet =
yield packet $=
conduitEncode $$
sinkSocket sock
instance Transport TCP where
runSession tcp@(TCP sock) session =
sourceSocket sock $=
conduitDecode $$
(runReaderT session (tcpSendPacketFn tcp))
closeConnection (TCP sock) = sClose sock
tcpClient :: HostName -> PortNumber -> IO TCP
tcpClient host port = do
sock <- socket AF_INET Stream defaultProtocol
sa <- SockAddrInet port <$> resolve host
connect sock sa
return $ TCP sock
data TCPServer = TCPServer {
getTcpListenSocket :: !Socket
}
instance Server TCPServer where
type ServerTransport TCPServer = TCP
runServer (TCPServer sock) handle = do
listen sock sOMAXCONN
forever $ do
(clientsock, _) <- accept sock
setSocketOption clientsock NoDelay 1
handle $ TCP clientsock
cleanup (TCPServer sock) = sClose sock
tcpServer :: PortNumber -> IO TCPServer
tcpServer port = do
sock <- socket AF_INET Stream defaultProtocol
setSocketOption sock ReuseAddr 1
bindSocket sock $ SockAddrInet port iNADDR_ANY
return $ TCPServer sock
sendt :: Term -> TransportM ()
sendt t = ask >>= \send -> liftIO . send . Packet $ t
recvt :: TransportM (Maybe Term)
recvt = fmap fromPacket <$> lift await
recvtForever :: (Term -> TransportM a) -> TransportM ()
recvtForever f =
ReaderT $ \send -> awaitForever $ flip runReaderT send . f . fromPacket
resolve :: HostName -> IO HostAddress
resolve host = do
r <- getAddrInfo (Just hints) (Just host) Nothing
case r of
(AddrInfo { addrAddress = (SockAddrInet _ addr) }:_) -> return addr
_ -> fail $ "Failed to resolve " ++ host
where
hints = defaultHints { addrFamily = AF_INET }