{-# 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 :: 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 ()
sendHeaders :: Builder -> Fd -> IO ()
sendHeaders = (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 ()
sendHeadersImpl :: (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize)
-> (Fd -> IO ()) -> Builder -> Fd -> IO ()
sendHeadersImpl 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