{-# LINE 1 "src/System/SendFile.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LINE 2 "src/System/SendFile.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.SendFile
( sendFile
, sendFileMode
, sendHeaders
, sendHeadersImpl
) where
{-# LINE 15 "src/System/SendFile.hsc" #-}
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 42 "src/System/SendFile.hsc" #-}
import qualified System.SendFile.Darwin as SF
{-# LINE 44 "src/System/SendFile.hsc" #-}
sendFile :: Fd
-> Fd
-> Word64
-> Word64
-> 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 90 "src/System/SendFile.hsc" #-}
flags = 0
{-# 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