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

------------------------------------------------------------------------------
-- | Linux system-dependent code for 'sendfile'.
module System.SendFile.Linux
  ( sendFile
  , sendFileImpl
  , sendFileMode
  ) where

------------------------------------------------------------------------------
import           Control.Concurrent (threadWaitWrite)
import           Data.Int           (Int64)
import           Data.Word          (Word64)
import           Foreign.C.Error    (throwErrnoIfMinus1RetryMayBlock)

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

{-# LINE 23 "src/System/SendFile/Linux.hsc" #-}
import           Foreign.Marshal    (alloca)
import           Foreign.Ptr        (Ptr, nullPtr)
import           Foreign.Storable   (poke)

{-# LINE 27 "src/System/SendFile/Linux.hsc" #-}
import           System.Posix.Types (COff (..), CSsize (..), Fd (..))

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


------------------------------------------------------------------------------
sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFile = (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
-> (Fd -> IO ()) -> Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFileImpl Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
c_sendfile Fd -> IO ()
threadWaitWrite
{-# INLINE sendFile #-}


------------------------------------------------------------------------------
sendFileImpl :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
             -> (Fd -> IO ())
             -> Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFileImpl :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
-> (Fd -> IO ()) -> Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFileImpl !Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
raw_sendfile !Fd -> IO ()
wait Fd
out_fd Fd
in_fd Word64
off Word64
count
  | Word64
count Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0 = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
  | Word64
off   Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = do
        CSsize
nsent <- (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
-> (Fd -> IO ()) -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
sendfile Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
raw_sendfile Fd -> IO ()
wait Fd
out_fd Fd
in_fd Ptr COff
forall a. Ptr a
nullPtr CSize
bytes
        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
nsent
  | Bool
otherwise  = (Ptr COff -> IO Int64) -> IO Int64
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr COff -> IO Int64) -> IO Int64)
-> (Ptr COff -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr COff
poff -> do
        Ptr COff -> COff -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr COff
poff (Word64 -> COff
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
off)
        CSsize
nsent <- (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
-> (Fd -> IO ()) -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
sendfile Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
raw_sendfile Fd -> IO ()
wait Fd
out_fd Fd
in_fd Ptr COff
poff CSize
bytes
        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
nsent
    where
      bytes :: CSize
bytes = Word64 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
count
{-# INLINE sendFileImpl #-}


------------------------------------------------------------------------------
sendfile :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
         -> (Fd -> IO ())
         -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
sendfile :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
-> (Fd -> IO ()) -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
sendfile Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
raw_sendfile Fd -> IO ()
wait Fd
out_fd Fd
in_fd Ptr COff
poff CSize
bytes =
    String -> IO CSsize -> IO () -> IO CSsize
forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
throwErrnoIfMinus1RetryMayBlock
            String
"sendfile"
            (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
raw_sendfile Fd
out_fd Fd
in_fd Ptr COff
poff CSize
bytes)
            (Fd -> IO ()
wait Fd
out_fd)
{-# INLINE sendfile #-}


------------------------------------------------------------------------------
-- sendfile64 gives LFS support
foreign import ccall unsafe "sys/sendfile.h sendfile64" c_sendfile
    :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize


------------------------------------------------------------------------------
sendFileMode :: String
sendFileMode :: String
sendFileMode = String
"LINUX_SENDFILE"