    {-# OPTIONS_GHC -optc-D_FILE_OFFSET_BITS=64 #-}
    {-# LINE 1 "Network/Sendfile/Linux.hsc" #-}
    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE CPP #-}

    module Network.Sendfile.Linux (
        sendfile
      , sendfile'
      , sendfileFd
      , sendfileFd'
      , sendfileWithHeader
      , sendfileFdWithHeader
      ) where

    import Control.Exception
    import Control.Monad
    import Data.ByteString as B
    import Data.ByteString.Internal
    import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
    import Foreign.C.Types
    import Foreign.Marshal (alloca)
    import Foreign.Ptr (Ptr, plusPtr, castPtr)
    import Foreign.ForeignPtr
    import Foreign.Storable (poke, sizeOf)
    import GHC.Conc (threadWaitWrite)
    import Network.Sendfile.Types
    import Network.Socket
    import System.Posix.Files
    import System.Posix.IO ( OpenMode(..)
                           , OpenFileFlags(..)
                           , defaultFileFlags
                           , closeFd
                           )
    import System.Posix.Types

    isLargeSize :: Bool
    isLargeSize :: Bool
    isLargeSize = CSize -> Int
    forall a. Storable a => a -> Int
    sizeOf (CSize
    0 :: CSize) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    8

    safeSize :: CSize
    safeSize :: CSize
    safeSize
      | Bool
    isLargeSize = CSize
    2CSize -> Int -> CSize
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    60 :: Int)
      | Bool
    otherwise   = CSize
    2CSize -> Int -> CSize
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    30 :: Int)

    ----------------------------------------------------------------

    -- |
    -- Simple binding for sendfile() of Linux.
    -- Used system calls:
    --
    --  - EntireFile -- open(), stat(), sendfile(), and close()
    --
    --  - PartOfFile -- open(), sendfile(), and close()
    --
    -- If the size of the file is unknown when sending the entire file,
    -- specifying PartOfFile is much faster.
    --
    -- The fourth action argument is called when a file is sent as chunks.
    -- Chucking is inevitable if the socket is non-blocking (this is the
    -- default) and the file is large. The action is called after a chunk
    -- is sent and before waiting the socket to be ready for writing.

    sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()
    sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()
    sendfile Socket
    sock FilePath
    path FileRange
    range IO ()
    hook = IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO Fd
    setup Fd -> IO ()
    teardown ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Fd
    fd ->
        Socket -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd Socket
    sock Fd
    fd FileRange
    range IO ()
    hook
      where
        setup :: IO Fd
    setup = FilePath -> OpenMode -> OpenFileFlags -> IO Fd
    openFd FilePath
    path OpenMode
    ReadOnly OpenFileFlags
    defaultFileFlags{nonBlock=True}
        teardown :: Fd -> IO ()
    teardown = Fd -> IO ()
    closeFd

    sendfile' :: Fd -> ByteString -> FileRange -> IO () -> IO ()
    sendfile' :: Fd -> ByteString -> FileRange -> IO () -> IO ()
    sendfile' Fd
    dst ByteString
    path FileRange
    range IO ()
    hook = IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO Fd
    setup Fd -> IO ()
    teardown ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Fd
    src ->
        Fd -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd' Fd
    dst Fd
    src FileRange
    range IO ()
    hook
      where
        setup :: IO Fd
    setup = ByteString -> OpenMode -> OpenFileFlags -> IO Fd
    openFdBS ByteString
    path OpenMode
    ReadOnly OpenFileFlags
    defaultFileFlags{nonBlock=True}
        teardown :: Fd -> IO ()
    teardown = Fd -> IO ()
    closeFd

    -- |
    -- Simple binding for sendfile() of Linux.
    -- Used system calls:
    --
    --  - EntireFile -- stat() and sendfile()
    --
    --  - PartOfFile -- sendfile()
    --
    -- If the size of the file is unknown when sending the entire file,
    -- specifying PartOfFile is much faster.
    --
    -- The fourth action argument is called when a file is sent as chunks.
    -- Chucking is inevitable if the socket is non-blocking (this is the
    -- default) and the file is large. The action is called after a chunk
    -- is sent and before waiting the socket to be ready for writing.
    sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd Socket
    sock Fd
    fd FileRange
    range IO ()
    hook = do

    {-# LINE 97 "Network/Sendfile/Linux.hsc" #-}
      withFdSocket sock $ \s -> do
        let dst = Fd s

    {-# LINE 104 "Network/Sendfile/Linux.hsc" #-}
        sendfileFd' dst fd range hook

    sendfileFd' :: Fd -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd' :: Fd -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd' Fd
    dst Fd
    src FileRange
    range IO ()
    hook =
        (Ptr COff -> IO ()) -> IO ()
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr COff -> IO ()) -> IO ()) -> (Ptr COff -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr COff
    offp -> case FileRange
    range of
            FileRange
    EntireFile -> do
                Ptr COff -> COff -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr COff
    offp COff
    0
                -- System call is very slow. Use PartOfFile instead.
                len <- FileStatus -> COff
    fileSize (FileStatus -> COff) -> IO FileStatus -> IO COff
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fd -> IO FileStatus
    getFdStatus Fd
    src
                let len' = COff -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral COff
    len
                sendfileloop dst src offp len' hook
            PartOfFile Integer
    off Integer
    len -> do
                Ptr COff -> COff -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr COff
    offp (Integer -> COff
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    off)
                let len' :: CSize
    len' = Integer -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    len
                Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO ()
    sendfileloop Fd
    dst Fd
    src Ptr COff
    offp CSize
    len' IO ()
    hook

    sendfileloop :: Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO ()
    sendfileloop :: Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO ()
    sendfileloop Fd
    dst Fd
    src Ptr COff
    offp CSize
    len IO ()
    hook = do
        -- Multicore IO manager use edge-trigger mode.
        -- So, calling threadWaitWrite only when errnor is eAGAIN.
        let toSend :: CSize
    toSend
              | CSize
    len CSize -> CSize -> Bool
    forall a. Ord a => a -> a -> Bool
    > CSize
    safeSize = CSize
    safeSize
              | Bool
    otherwise      = CSize
    len
        bytes <- Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
    c_sendfile Fd
    dst Fd
    src Ptr COff
    offp CSize
    toSend
        case bytes of
            -1 -> do
                errno <- IO Errno
    getErrno
                if errno == eAGAIN then do
                    threadWaitWrite dst
                    sendfileloop dst src offp len hook
                  else
                    throwErrno "Network.SendFile.Linux.sendfileloop"
            CSsize
    0  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- the file is truncated
            CSsize
    _  -> do
                IO ()
    hook
                let left :: CSize
    left = CSize
    len CSize -> CSize -> CSize
    forall a. Num a => a -> a -> a
    - CSsize -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CSsize
    bytes
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CSize
    left CSize -> CSize -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CSize
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO ()
    sendfileloop Fd
    dst Fd
    src Ptr COff
    offp CSize
    left IO ()
    hook

    -- Dst Src in order. take care
    foreign import ccall unsafe "sendfile"
        c_sendfile :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize

    ----------------------------------------------------------------

    -- |
    -- Simple binding for send() and sendfile() of Linux.
    -- Used system calls:
    --
    --  - EntireFile -- send(), open(), stat(), sendfile(), and close()
    --
    --  - PartOfFile -- send(), open(), sendfile(), and close()
    --
    -- The fifth header is sent with send() + the MSG_MORE flag. If the
    -- file is small enough, the header and the file is send in a single
    -- TCP packet.
    --
    -- If the size of the file is unknown when sending the entire file,
    -- specifying PartOfFile is much faster.
    --
    -- The fourth action argument is called when a file is sent as chunks.
    -- Chucking is inevitable if the socket is non-blocking (this is the
    -- default) and the file is large. The action is called after a chunk
    -- is sent and before waiting the socket to be ready for writing.

    sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString] -> IO ()
    sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString] -> IO ()
    sendfileWithHeader Socket
    sock FilePath
    path FileRange
    range IO ()
    hook [ByteString]
    hdr = do
        -- Copying is much faster than syscall.
        Socket -> ByteString -> IO ()
    sendMsgMore Socket
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [ByteString]
    hdr
        Socket -> FilePath -> FileRange -> IO () -> IO ()
    sendfile Socket
    sock FilePath
    path FileRange
    range IO ()
    hook

    -- |
    -- Simple binding for send() and sendfile() of Linux.
    -- Used system calls:
    --
    --  - EntireFile -- send(), stat() and sendfile()
    --
    --  - PartOfFile -- send() and sendfile()
    --
    -- The fifth header is sent with send() + the MSG_MORE flag. If the
    -- file is small enough, the header and the file is send in a single
    -- TCP packet.
    --
    -- If the size of the file is unknown when sending the entire file,
    -- specifying PartOfFile is much faster.
    --
    -- The fourth action argument is called when a file is sent as chunks.
    -- Chucking is inevitable if the socket is non-blocking (this is the
    -- default) and the file is large. The action is called after a chunk
    -- is sent and before waiting the socket to be ready for writing.

    sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] -> IO ()
    sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] -> IO ()
    sendfileFdWithHeader Socket
    sock Fd
    fd FileRange
    range IO ()
    hook [ByteString]
    hdr = do
        -- Copying is much faster than syscall.
        Socket -> ByteString -> IO ()
    sendMsgMore Socket
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [ByteString]
    hdr
        Socket -> Fd -> FileRange -> IO () -> IO ()
    sendfileFd Socket
    sock Fd
    fd FileRange
    range IO ()
    hook

    sendMsgMore :: Socket -> ByteString -> IO ()
    sendMsgMore :: Socket -> ByteString -> IO ()
    sendMsgMore Socket
    sock ByteString
    bs = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do

    {-# LINE 203 "Network/Sendfile/Linux.hsc" #-}
      withFdSocket sock $ \fd -> do
        let s = Fd fd

    {-# LINE 210 "Network/Sendfile/Linux.hsc" #-}
        let buf = castPtr (ptr `plusPtr` off)
            siz = fromIntegral len
        sendloop s buf siz
      where
        PS ForeignPtr Word8
    fptr Int
    off Int
    len = ByteString
    bs

    sendloop :: Fd -> Ptr CChar -> CSize -> IO ()
    sendloop :: Fd -> Ptr CChar -> CSize -> IO ()
    sendloop Fd
    s Ptr CChar
    buf CSize
    len = do
        bytes <- Fd -> Ptr CChar -> CSize -> CInt -> IO CSsize
    c_send Fd
    s Ptr CChar
    buf CSize
    len (CInt
    32768)
    {-# LINE 219 "Network/Sendfile/Linux.hsc" #-}
        if bytes == -1 then do
            errno <- getErrno
            if errno == eAGAIN then do
                threadWaitWrite s
                sendloop s buf len
              else
                throwErrno "Network.SendFile.Linux.sendloop"
          else do
            let sent = fromIntegral bytes
            when (sent /= len) $ do
                let left = len - sent
                    ptr = buf `plusPtr` fromIntegral bytes
                sendloop s ptr left

    foreign import ccall unsafe "send"
      c_send :: Fd -> Ptr CChar -> CSize -> CInt -> IO CSsize