{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Socket.ByteString.Lazy.Posix (
    -- * Send data to a socket
    send
  , sendAll
  ) where

import qualified Data.ByteString.Lazy               as L
import           Data.ByteString.Unsafe             (unsafeUseAsCStringLen)
import           Foreign.Marshal.Array              (allocaArray)

import           Network.Socket.ByteString.IO       (waitWhen0)
import           Network.Socket.ByteString.Internal (c_writev)
import           Network.Socket.Imports
import           Network.Socket.Internal
import           Network.Socket.Posix.IOVec    (IOVec (IOVec))
import           Network.Socket.Types

-- -----------------------------------------------------------------------------
-- Sending
send
    :: Socket -- ^ Connected socket
    -> L.ByteString -- ^ Data to send
    -> IO Int64 -- ^ Number of bytes sent
send :: Socket -> ByteString -> IO Int64
send Socket
s ByteString
lbs = do
    let cs :: [ByteString]
cs  = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
maxNumChunks (ByteString -> [ByteString]
L.toChunks ByteString
lbs)
        len :: Int
len = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
cs
    CSsize
siz <- Socket -> (CInt -> IO CSsize) -> IO CSsize
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CSsize) -> IO CSsize)
-> (CInt -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> Int -> (Ptr IOVec -> IO CSsize) -> IO CSsize
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len ((Ptr IOVec -> IO CSsize) -> IO CSsize)
-> (Ptr IOVec -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \Ptr IOVec
ptr ->
             [ByteString] -> Ptr IOVec -> (CInt -> IO CSsize) -> IO CSsize
forall t a.
Num t =>
[ByteString] -> Ptr IOVec -> (t -> IO a) -> IO a
withPokes [ByteString]
cs Ptr IOVec
ptr ((CInt -> IO CSsize) -> IO CSsize)
-> (CInt -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$ \CInt
niovs ->
               Socket -> String -> IO CSsize -> IO CSsize
forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitWrite Socket
s String
"writev" (IO CSsize -> IO CSsize) -> IO CSsize -> IO CSsize
forall a b. (a -> b) -> a -> b
$ CInt -> Ptr IOVec -> CInt -> IO CSsize
c_writev CInt
fd Ptr IOVec
ptr CInt
niovs
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ CSsize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSsize
siz
  where
    withPokes :: [ByteString] -> Ptr IOVec -> (t -> IO a) -> IO a
withPokes [ByteString]
ss Ptr IOVec
p t -> IO a
f = [ByteString] -> Ptr IOVec -> Int -> t -> IO a
loop [ByteString]
ss Ptr IOVec
p Int
0 t
0
      where
        loop :: [ByteString] -> Ptr IOVec -> Int -> t -> IO a
loop (ByteString
c:[ByteString]
cs) Ptr IOVec
q Int
k !t
niovs
            | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxNumBytes = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
c ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) -> do
                Ptr IOVec -> IOVec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr IOVec
q (IOVec -> IO ()) -> IOVec -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> CSize -> IOVec
IOVec (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
                [ByteString] -> Ptr IOVec -> Int -> t -> IO a
loop [ByteString]
cs
                     (Ptr IOVec
q Ptr IOVec -> Int -> Ptr IOVec
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` IOVec -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8 -> CSize -> IOVec
IOVec Ptr Word8
forall a. Ptr a
nullPtr CSize
0))
                     (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
                     (t
niovs t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
            | Bool
otherwise = t -> IO a
f t
niovs
        loop [ByteString]
_ Ptr IOVec
_ Int
_ t
niovs = t -> IO a
f t
niovs
    maxNumBytes :: Int
maxNumBytes  = Int
4194304 :: Int -- maximum number of bytes to transmit in one system call
    maxNumChunks :: Int
maxNumChunks = Int
1024 :: Int -- maximum number of chunks to transmit in one system call

sendAll
    :: Socket -- ^ Connected socket
    -> L.ByteString -- ^ Data to send
    -> IO ()
sendAll :: Socket -> ByteString -> IO ()
sendAll Socket
_ ByteString
"" = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendAll Socket
s ByteString
bs0 = ByteString -> IO ()
loop ByteString
bs0
  where
    loop :: ByteString -> IO ()
loop ByteString
bs = do
        -- "send" throws an exception.
        Int64
sent <- Socket -> ByteString -> IO Int64
send Socket
s ByteString
bs
        Int -> Socket -> IO ()
waitWhen0 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sent) Socket
s
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
sent Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int64
L.length ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
loop (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
L.drop Int64
sent ByteString
bs