{-# LANGUAGE RankNTypes #-}
module Pipes.Network.TCP (
fromSocket
, fromSocketTimeout
, fromSocketN
, fromSocketTimeoutN
, toSocket
, toSocketTimeout
, module Network.Simple.TCP
) where
import qualified Data.ByteString as B
import Foreign.C.Error (errnoToIOError, eTIMEDOUT)
import qualified Network.Socket.ByteString as NSB
import Network.Simple.TCP
(connect, serve, listen, accept, acceptFork,
bindSock, connectSock, recv, send, withSocketsDo,
HostName, HostPreference(HostAny, HostIPv4, HostIPv6, Host),
ServiceName, SockAddr, Socket)
import Pipes
import Pipes.Core
import System.Timeout (timeout)
fromSocket
:: MonadIO m
=> Socket
-> Int
-> Producer' B.ByteString m ()
fromSocket sock nbytes = loop where
loop = do
bs <- liftIO (NSB.recv sock nbytes)
if B.null bs
then return ()
else yield bs >> loop
fromSocketTimeout
:: MonadIO m
=> Int -> Socket -> Int -> Producer' B.ByteString m ()
fromSocketTimeout wait sock nbytes = loop where
loop = do
mbs <- liftIO (timeout wait (NSB.recv sock nbytes))
case mbs of
Just bs -> yield bs >> loop
Nothing -> liftIO $ ioError $ errnoToIOError
"Pipes.Network.TCP.fromSocketTimeout" eTIMEDOUT Nothing Nothing
fromSocketN :: MonadIO m => Socket -> Int -> Server' Int B.ByteString m ()
fromSocketN sock = loop where
loop = \nbytes -> do
bs <- liftIO (NSB.recv sock nbytes)
if B.null bs
then return ()
else respond bs >>= loop
fromSocketTimeoutN
:: MonadIO m
=> Int -> Socket -> Int -> Server' Int B.ByteString m ()
fromSocketTimeoutN wait sock = loop where
loop = \nbytes -> do
mbs <- liftIO (timeout wait (NSB.recv sock nbytes))
case mbs of
Just bs -> respond bs >>= loop
Nothing -> liftIO $ ioError $ errnoToIOError
"Pipes.Network.TCP.fromSocketTimeoutN" eTIMEDOUT Nothing Nothing
toSocket
:: MonadIO m
=> Socket
-> Consumer' B.ByteString m r
toSocket sock = for cat (\a -> send sock a)
toSocketTimeout
:: MonadIO m
=> Int -> Socket -> Consumer' B.ByteString m r
toSocketTimeout wait sock = for cat $ \a -> do
mu <- liftIO (timeout wait (NSB.sendAll sock a))
case mu of
Just () -> return ()
Nothing -> liftIO $ ioError $ errnoToIOError
"Pipes.Network.TCP.toSocketTimeout" eTIMEDOUT Nothing Nothing