{-# LINE 1 "src/System/SendFile.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
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
-> Fd
-> Word64
-> Word64
-> IO ()
sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO ()
sendFile Fd
out_fd Fd
in_fd = Word64 -> Word64 -> IO ()
go
where
go :: Word64 -> Word64 -> IO ()
go Word64
offs Word64
count | Word64
offs Word64 -> Bool -> Bool
`seq` Word64
count Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
| Bool
otherwise = do
Word64
nsent <- Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> IO Int64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Fd -> Fd -> Word64 -> Word64 -> IO Int64
SF.sendFile Fd
out_fd Fd
in_fd
Word64
offs Word64
count
Word64 -> Word64 -> IO ()
go (Word64
offs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nsent)
(Word64
count Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
nsent)
sendFileMode :: String
sendFileMode :: String
sendFileMode = String
SF.sendFileMode
{-# INLINE sendHeaders #-}
sendHeaders :: Builder -> Fd -> IO ()
= (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize)
-> (Fd -> IO ()) -> Builder -> Fd -> IO ()
sendHeadersImpl Fd -> Ptr CChar -> CSize -> CInt -> IO CSize
c_send Fd -> IO ()
threadWaitWrite
{-# INLINE sendHeadersImpl #-}
sendHeadersImpl :: (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize)
-> (Fd -> IO ())
-> Builder
-> Fd
-> IO ()
Fd -> Ptr CChar -> CSize -> CInt -> IO CSize
sendFunc Fd -> IO ()
waitFunc Builder
headers Fd
fd =
Fd -> Ptr CChar -> CSize -> CInt -> IO CSize
sendFunc (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize) -> IO () -> IO ()
`seq` Fd -> IO ()
waitFunc (Fd -> IO ()) -> IO () -> IO ()
`seq`
ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
S.unsafeUseAsCStringLen ([ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks
(ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
headers) ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\(Ptr CChar
cstr, Int
clen) -> Ptr CChar -> CSize -> IO ()
go Ptr CChar
cstr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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