{-# LINE 1 "src/System/SendFile.hsc" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | Snap's unified interface to sendfile.
-- Modified from sendfile 0.6.1

module System.SendFile
  ( sendFile
  , sendFileMode
  , sendHeaders
  , sendHeadersImpl
  ) where



------------------------------------------------------------------------------
import           Control.Concurrent         (threadWaitWrite)
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Unsafe     as S
import           Data.Word                  (Word64)
import           Foreign.C.Error            (throwErrnoIfMinus1RetryMayBlock)

{-# LINE 24 "src/System/SendFile.hsc" #-}
import           Foreign.C.Types            (CChar (..), CInt (..), CSize (..))

{-# LINE 28 "src/System/SendFile.hsc" #-}
import           Foreign.Ptr                (Ptr, plusPtr)

{-# LINE 30 "src/System/SendFile.hsc" #-}
import           System.Posix.Types         (Fd (..))

{-# LINE 34 "src/System/SendFile.hsc" #-}
------------------------------------------------------------------------------
import           Data.ByteString.Builder    (Builder, toLazyByteString)
------------------------------------------------------------------------------

{-# LINE 38 "src/System/SendFile.hsc" #-}
import qualified System.SendFile.Linux      as SF

{-# LINE 44 "src/System/SendFile.hsc" #-}


------------------------------------------------------------------------------
sendFile :: Fd                  -- ^ out fd (i.e. the socket)
         -> Fd                  -- ^ in fd (i.e. the file)
         -> Word64              -- ^ offset in bytes
         -> Word64              -- ^ count in bytes
         -> IO ()
sendFile out_fd in_fd = go
  where
    go offs count | offs `seq` count <= 0 = return $! ()
                  | otherwise = do
                        nsent <- fromIntegral `fmap`
                                 SF.sendFile out_fd in_fd
                                             offs count
                        go (offs + nsent)
                           (count - nsent)


------------------------------------------------------------------------------
sendFileMode :: String
sendFileMode = SF.sendFileMode


------------------------------------------------------------------------------
{-# INLINE sendHeaders #-}
sendHeaders :: Builder -> Fd -> IO ()
sendHeaders = sendHeadersImpl c_send threadWaitWrite


------------------------------------------------------------------------------
{-# INLINE sendHeadersImpl #-}
sendHeadersImpl :: (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize)
                -> (Fd -> IO ())
                -> Builder
                -> Fd
                -> IO ()
sendHeadersImpl sendFunc waitFunc headers fd =
    sendFunc `seq` waitFunc `seq`
    S.unsafeUseAsCStringLen (S.concat $ L.toChunks
                                      $ toLazyByteString headers) $
         \(cstr, clen) -> go cstr (fromIntegral clen)
  where

{-# LINE 88 "src/System/SendFile.hsc" #-}
    flags = (32768)
{-# LINE 89 "src/System/SendFile.hsc" #-}

{-# LINE 92 "src/System/SendFile.hsc" #-}

    go cstr clen | cstr `seq` clen <= 0 = return $! ()
                 | otherwise = do
                       nsent <- throwErrnoIfMinus1RetryMayBlock
                                   "sendHeaders"
                                   (sendFunc fd cstr clen flags)
                                   (waitFunc fd)
                       let cstr' = plusPtr cstr (fromIntegral nsent)
                       go cstr' (clen - nsent)


------------------------------------------------------------------------------
foreign import ccall unsafe "sys/socket.h send" c_send
    :: Fd -> Ptr CChar -> CSize -> CInt -> IO CSize