{-# LANGUAGE CPP #-}
module Network.Socket.ByteString.Lazy (
send,
sendAll,
sendWithFds,
sendWith,
sendAllWith,
getContents,
recv,
recvWith,
) where
import Control.Concurrent.STM (STM)
import Data.ByteString.Lazy.Internal (
ByteString (..),
defaultChunkSize,
)
import Network.Socket (ShutdownCmd (..), shutdown)
import System.IO.Error (catchIOError)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Posix.Types (Fd (..))
import Prelude hiding (getContents)
#if defined(mingw32_HOST_OS)
import Network.Socket.ByteString.Lazy.Windows (send, sendAll)
#else
import Network.Socket.ByteString.Lazy.Posix (send, sendAll)
#endif
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Network.Socket.ByteString as N
import Network.Socket.Imports
import Network.Socket.Types
#if !defined(mingw32_HOST_OS)
import Network.Socket.Wait (withWritable)
#endif
sendWithFds
:: Socket
-> ByteString
-> [Fd]
-> IO ()
sendWithFds :: Socket -> ByteString -> [Fd] -> IO ()
sendWithFds Socket
s ByteString
lbs [Fd]
fds = Socket -> [ByteString] -> [Fd] -> IO ()
N.sendManyWithFds Socket
s (ByteString -> [ByteString]
L.toChunks ByteString
lbs) [Fd]
fds
sendWith :: Socket -> ByteString -> STM a -> IO (Either a Int64)
#if defined(mingw32_HOST_OS)
sendWith s lbs giveUp = fmap fromIntegral <$> N.sendWith s chunk giveUp
where
chunk = case L.toChunks lbs of
[] -> S.empty
x : _ -> x
#else
sendWith :: forall a. Socket -> ByteString -> STM a -> IO (Either a Int64)
sendWith Socket
s ByteString
lbs STM a
giveUp = Socket -> STM a -> IO Int64 -> IO (Either a Int64)
forall a b. Socket -> STM a -> IO b -> IO (Either a b)
withWritable Socket
s STM a
giveUp (IO Int64 -> IO (Either a Int64))
-> IO Int64 -> IO (Either a Int64)
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> IO Int64
send Socket
s ByteString
lbs
#endif
sendAllWith :: Socket -> ByteString -> STM a -> IO (Either a ())
sendAllWith :: forall a. Socket -> ByteString -> STM a -> IO (Either a ())
sendAllWith Socket
s ByteString
lbs = Socket -> [ByteString] -> STM a -> IO (Either a ())
forall a. Socket -> [ByteString] -> STM a -> IO (Either a ())
N.sendManyWith Socket
s (ByteString -> [ByteString]
L.toChunks ByteString
lbs)
getContents
:: Socket
-> IO ByteString
getContents :: Socket -> IO ByteString
getContents Socket
s = IO ByteString
loop
where
loop :: IO ByteString
loop = IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
sbs <- Socket -> Int -> IO ByteString
N.recv Socket
s Int
defaultChunkSize
if S.null sbs
then do
shutdown s ShutdownReceive `catchIOError` const (return ())
return Empty
else Chunk sbs <$> loop
recv
:: Socket
-> Int64
-> IO ByteString
recv :: Socket -> Int64 -> IO ByteString
recv Socket
s Int64
nbytes = ByteString -> ByteString
chunk (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> IO ByteString
N.recv Socket
s (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nbytes)
where
chunk :: ByteString -> ByteString
chunk ByteString
k
| ByteString -> Bool
S.null ByteString
k = ByteString
Empty
| Bool
otherwise = ByteString -> ByteString -> ByteString
Chunk ByteString
k ByteString
Empty
recvWith :: Socket -> Int64 -> STM a -> IO (Either a ByteString)
recvWith :: forall a. Socket -> Int64 -> STM a -> IO (Either a ByteString)
recvWith Socket
s Int64
nbytes STM a
giveUp = (ByteString -> ByteString)
-> Either a ByteString -> Either a ByteString
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
chunk (Either a ByteString -> Either a ByteString)
-> IO (Either a ByteString) -> IO (Either a ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> STM a -> IO (Either a ByteString)
forall a. Socket -> Int -> STM a -> IO (Either a ByteString)
N.recvWith Socket
s (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nbytes) STM a
giveUp
where
chunk :: ByteString -> ByteString
chunk ByteString
k
| ByteString -> Bool
S.null ByteString
k = ByteString
Empty
| Bool
otherwise = ByteString -> ByteString -> ByteString
Chunk ByteString
k ByteString
Empty