    {-# 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 :: [StrictByteString]
    cs = Int -> [StrictByteString] -> [StrictByteString]
    forall a. Int -> [a] -> [a]
    take Int
    maxNumChunks (ByteString -> [StrictByteString]
    L.toChunks ByteString
    lbs)
            len :: Int
    len = [StrictByteString] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [StrictByteString]
    cs
        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 ->
            [StrictByteString] -> Ptr IOVec -> (CInt -> IO CSsize) -> IO CSsize
    forall {t} {a}.
    Num t =>
    [StrictByteString] -> Ptr IOVec -> (t -> IO a) -> IO a
    withPokes [StrictByteString]
    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
        return $ fromIntegral siz
      where
        withPokes :: [StrictByteString] -> Ptr IOVec -> (t -> IO a) -> IO a
    withPokes [StrictByteString]
    ss Ptr IOVec
    p t -> IO a
    f = [StrictByteString] -> Ptr IOVec -> Int -> t -> IO a
    loop [StrictByteString]
    ss Ptr IOVec
    p Int
    0 t
    0
          where
            loop :: [StrictByteString] -> Ptr IOVec -> Int -> t -> IO a
    loop (StrictByteString
    c : [StrictByteString]
    cs) Ptr IOVec
    q Int
    k t
    niovs
                | Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    maxNumBytes = StrictByteString -> (CStringLen -> IO a) -> IO a
    forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen StrictByteString
    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)
                    [StrictByteString] -> Ptr IOVec -> Int -> t -> IO a
    loop
                        [StrictByteString]
    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 [StrictByteString]
    _ 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 a. a -> IO a
    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.
            sent <- Socket -> ByteString -> IO Int64
    send Socket
    s ByteString
    bs
            waitWhen0 (fromIntegral sent) s
            when (sent /= L.length bs) $ loop $ L.drop sent bs