{-# LINE 1 "src/Network/Socket/SendFile/Linux.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Network.Socket.SendFile.Linux (_sendFile, sendFileIter, sendfile) where
import Data.Int (Int32, Int64)
import Data.Word (Word32, Word64)
import Foreign.C (CInt(..))
import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
import Foreign.Marshal (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable(poke)
import Network.Socket.SendFile.Iter (Iter(..), runIter)
import System.Posix.Types (Fd(..))
_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()
_sendFile out_fd in_fd off count =
do _ <- runIter (sendFileIter out_fd in_fd count off count)
return ()
sendFileIter :: Fd
-> Fd
-> Int64
-> Int64
-> Int64
-> IO Iter
sendFileIter out_fd in_fd blockSize off remaining =
sendFileIterI out_fd in_fd (min blockSize maxBytes) off remaining
sendFileIterI :: Fd
-> Fd
-> Int64
-> Int64
-> Int64
-> IO Iter
sendFileIterI _out_fd _in_fd _blockSize _off 0 = return (Done 0)
sendFileIterI out_fd in_fd blockSize off remaining =
do let bytes = min remaining blockSize
(wouldBlock, sbytes) <- sendfile out_fd in_fd off bytes
let cont = sendFileIterI out_fd in_fd blockSize (off + sbytes) (remaining `safeMinus` sbytes)
case wouldBlock of
True -> return (WouldBlock sbytes out_fd cont)
False -> return (Sent sbytes cont)
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile out_fd in_fd off bytes =
alloca $ \poff ->
do poke poff off
sendfileI out_fd in_fd poff bytes
sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI out_fd in_fd poff bytes = do
sbytes <- {-# SCC "c_sendfile" #-} c_sendfile out_fd in_fd poff (fromIntegral bytes)
if sbytes <= -1
then do errno <- getErrno
if errno == eAGAIN
then return (True, 0)
else throwErrno "Network.Socket.SendFile.Linux.sendfileI"
else return (False, fromIntegral sbytes)
safeMinus :: (Ord a, Num a, Show a) => a -> a -> a
safeMinus x y
| y > x = error $ "y > x " ++ show (y,x)
| otherwise = x - y
maxBytes :: Int64
maxBytes = fromIntegral (maxBound :: (Int64))
{-# LINE 80 "src/Network/Socket/SendFile/Linux.hsc" #-}
foreign import ccall unsafe "sendfile64" c_sendfile
:: Fd -> Fd -> Ptr (Int64) -> (Word64) -> IO (Int64)
{-# LINE 84 "src/Network/Socket/SendFile/Linux.hsc" #-}