    {-# 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.Internal (c_writev)
    import           Network.Socket.ByteString.IO       (waitWhen0)
    import           Network.Socket.ByteString.IOVec    (IOVec (IOVec))
    import           Network.Socket.Imports
    import           Network.Socket.Internal
    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 s :: Socket
    s lbs :: 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
    $ \fd :: 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 :: 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
    $ \niovs :: CInt
    niovs ->
                   Socket -> String -> IO CSsize -> IO CSsize
    forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a
    throwSocketErrorWaitWrite Socket
    s "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 ss :: [ByteString]
    ss p :: Ptr IOVec
    p f :: t -> IO a
    f = [ByteString] -> Ptr IOVec -> Int -> t -> IO a
    loop [ByteString]
    ss Ptr IOVec
    p 0 0
          where
            loop :: [ByteString] -> Ptr IOVec -> Int -> t -> IO a
    loop (c :: ByteString
    c:cs :: [ByteString]
    cs) q :: Ptr IOVec
    q k :: 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 :: Ptr CChar
    ptr, len :: 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 CChar -> CSize -> IOVec
    IOVec 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 (IOVec
    forall a. HasCallStack => a
    undefined :: IOVec))
                         (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
    + 1)
                | Bool
    otherwise = t -> IO a
    f t
    niovs
            loop _ _ _ niovs :: t
    niovs = t -> IO a
    f t
    niovs
        maxNumBytes :: Int
    maxNumBytes  = 4194304 :: Int -- maximum number of bytes to transmit in one system call
        maxNumChunks :: Int
    maxNumChunks = 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 _ "" = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    sendAll s :: Socket
    s bs :: ByteString
    bs = do
        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. Ord a => a -> a -> Bool
    >= 0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Socket -> ByteString -> IO ()
    sendAll Socket
    s (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int64 -> ByteString -> ByteString
    L.drop Int64
    sent ByteString
    bs