{-# 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 :: Fd -> Fd -> Int64 -> Int64 -> IO ()
_sendFile out_fd :: Fd
out_fd in_fd :: Fd
in_fd off :: Int64
off count :: Int64
count =
do Int64
_ <- IO Iter -> IO Int64
runIter (Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIter Fd
out_fd Fd
in_fd Int64
count Int64
off Int64
count)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendFileIter :: Fd
-> Fd
-> Int64
-> Int64
-> Int64
-> IO Iter
sendFileIter :: Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIter out_fd :: Fd
out_fd in_fd :: Fd
in_fd blockSize :: Int64
blockSize off :: Int64
off remaining :: Int64
remaining =
Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIterI Fd
out_fd Fd
in_fd (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
blockSize Int64
maxBytes) Int64
off Int64
remaining
sendFileIterI :: Fd
-> Fd
-> Int64
-> Int64
-> Int64
-> IO Iter
sendFileIterI :: Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIterI _out_fd :: Fd
_out_fd _in_fd :: Fd
_in_fd _blockSize :: Int64
_blockSize _off :: Int64
_off 0 = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done 0)
sendFileIterI out_fd :: Fd
out_fd in_fd :: Fd
in_fd blockSize :: Int64
blockSize off :: Int64
off remaining :: Int64
remaining =
do let bytes :: Int64
bytes = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
remaining Int64
blockSize
(wouldBlock :: Bool
wouldBlock, sbytes :: Int64
sbytes) <- Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile Fd
out_fd Fd
in_fd Int64
off Int64
bytes
let cont :: IO Iter
cont = Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIterI Fd
out_fd Fd
in_fd Int64
blockSize (Int64
off Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
sbytes) (Int64
remaining Int64 -> Int64 -> Int64
forall a. (Ord a, Num a, Show a) => a -> a -> a
`safeMinus` Int64
sbytes)
case Bool
wouldBlock of
True -> Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Fd -> IO Iter -> Iter
WouldBlock Int64
sbytes Fd
out_fd IO Iter
cont)
False -> Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent Int64
sbytes IO Iter
cont)
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile out_fd :: Fd
out_fd in_fd :: Fd
in_fd off :: Int64
off bytes :: Int64
bytes =
(Ptr Int64 -> IO (Bool, Int64)) -> IO (Bool, Int64)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int64 -> IO (Bool, Int64)) -> IO (Bool, Int64))
-> (Ptr Int64 -> IO (Bool, Int64)) -> IO (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ \poff :: Ptr Int64
poff ->
do Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int64
poff Int64
off
Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI Fd
out_fd Fd
in_fd Ptr Int64
poff Int64
bytes
sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI out_fd :: Fd
out_fd in_fd :: Fd
in_fd poff :: Ptr Int64
poff bytes :: Int64
bytes = do
Int64
sbytes <- {-# SCC "c_sendfile" #-} Fd -> Fd -> Ptr Int64 -> Word64 -> IO Int64
c_sendfile Fd
out_fd Fd
in_fd Ptr Int64
poff (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bytes)
if Int64
sbytes Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= -1
then do Errno
errno <- IO Errno
getErrno
if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eAGAIN
then (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, 0)
else String -> IO (Bool, Int64)
forall a. String -> IO a
throwErrno "Network.Socket.SendFile.Linux.sendfileI"
else (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sbytes)
safeMinus :: (Ord a, Num a, Show a) => a -> a -> a
safeMinus :: a -> a -> a
safeMinus x :: a
x y :: a
y
| a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "y > x " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, a) -> String
forall a. Show a => a -> String
show (a
y,a
x)
| Bool
otherwise = a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y
maxBytes :: Int64
maxBytes :: Int64
maxBytes = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
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" #-}