{-# LANGUAGE Rank2Types, TypeFamilies #-}
module Pipes.Network.TCP.Safe (
connect
, serve
, listen
, accept
, fromConnect
, toConnect
, fromServe
, toServe
, module Pipes.Network.TCP
, module Network.Simple.TCP
, module Pipes.Safe
) where
import Control.Monad
import qualified Data.ByteString as B
import Network.Simple.TCP
(acceptFork, bindSock, connectSock, recv, send, withSocketsDo,
HostName, HostPreference(HostAny, HostIPv4, HostIPv6, Host),
ServiceName, SockAddr, Socket)
import qualified Network.Socket as NS
import Pipes
import Pipes.Network.TCP
(fromSocket, fromSocketTimeout, fromSocketN,
fromSocketTimeoutN, toSocket, toSocketTimeout)
import qualified Pipes.Safe as Ps
import Pipes.Safe (runSafeT)
connect
:: Ps.MonadSafe m
=> HostName -> ServiceName -> ((Socket, SockAddr) -> m r) -> m r
connect host port = Ps.bracket (connectSock host port)
(liftIO . NS.sClose . fst)
serve
:: Ps.MonadSafe m
=> HostPreference -> ServiceName -> ((Socket, SockAddr) -> IO ()) -> m r
serve hp port k = do
listen hp port $ \(lsock,_) -> do
forever $ acceptFork lsock k
listen
:: Ps.MonadSafe m
=> HostPreference -> ServiceName -> ((Socket, SockAddr) -> m r) -> m r
listen hp port = Ps.bracket listen' (liftIO . NS.sClose . fst)
where
listen' = liftIO $ do
x@(bsock,_) <- bindSock hp port
NS.listen bsock (max 2048 NS.maxListenQueue)
return x
accept
:: Ps.MonadSafe m
=> Socket -> ((Socket, SockAddr) -> m r) -> m r
accept lsock k = do
conn@(csock,_) <- liftIO (NS.accept lsock)
Ps.finally (k conn) (liftIO $ NS.sClose csock)
fromConnect
:: Ps.MonadSafe m
=> Int
-> HostName
-> ServiceName
-> Producer' B.ByteString m ()
fromConnect nbytes host port = do
connect host port $ \(csock,_) -> do
fromSocket csock nbytes
toConnect
:: Ps.MonadSafe m
=> HostName
-> ServiceName
-> Consumer' B.ByteString m r
toConnect hp port = do
connect hp port $ \(csock,_) -> do
toSocket csock
fromServe
:: Ps.MonadSafe m
=> Int
-> HostPreference
-> ServiceName
-> Producer' B.ByteString m ()
fromServe nbytes hp port = do
listen hp port $ \(lsock,_) -> do
accept lsock $ \(csock,_) -> do
fromSocket csock nbytes
toServe
:: Ps.MonadSafe m
=> HostPreference
-> ServiceName
-> Consumer' B.ByteString m r
toServe hp port = do
listen hp port $ \(lsock,_) -> do
accept lsock $ \(csock,_) -> do
toSocket csock