{-# LINE 1 "src/Network/Socket/SendFile/Linux.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- | Linux system-dependent code for 'sendfile'.
module Network.Socket.SendFile.Linux (_sendFile, sendFileIter, sendfile) where

import Data.Int (Int32, Int64)    -- Int64 is imported on 64-bit systems
import Data.Word (Word32, Word64) -- Word64 is imported on 64-bit systems
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(..))



-- | automatically loop and send everything
_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()
_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()
_sendFile Fd
out_fd Fd
in_fd Int64
off 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) -- set blockSize == count. ie. send it all if we can.
       () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | a way to send things in chunks
sendFileIter :: Fd -- ^ file descriptor corresponding to network socket
             -> Fd -- ^ file descriptor corresponding to file
             -> Int64 -- ^ maximum number of bytes to send at once
             -> Int64 -- ^ offset into file
             -> Int64 -- ^ total number of bytes to send
             -> IO Iter
sendFileIter :: Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIter Fd
out_fd Fd
in_fd Int64
blockSize Int64
off Int64
remaining =
--    alloca $ \poff -> 
--        do poke poff off
           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 -- ^ file descriptor corresponding to network socket
              -> Fd -- ^ file descriptor corresponding to file
              -> Int64 -- ^ maximum number of bytes to send at once
              -> Int64 -- ^ offset into file
              -> Int64     -- ^ total number of bytes to send
              -> IO Iter
sendFileIterI :: Fd -> Fd -> Int64 -> Int64 -> Int64 -> IO Iter
sendFileIterI Fd
_out_fd Fd
_in_fd Int64
_blockSize Int64
_off  Int64
0         = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done Int64
0)
sendFileIterI  Fd
out_fd  Fd
in_fd  Int64
blockSize  Int64
off  Int64
remaining =
    do let bytes :: Int64
bytes = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
remaining Int64
blockSize
       (Bool
wouldBlock, 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
         Bool
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)
         Bool
False -> Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent Int64
sbytes IO Iter
cont)

-- | low-level wrapper around sendfile
-- non-blocking
-- returns number of bytes written and whether the fd would block (aka, EAGAIN)
-- does not call 'threadWaitWrite'
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile Fd
out_fd Fd
in_fd Int64
off 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
$ \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

-- low-level wrapper around linux sendfile
sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64)
sendfileI Fd
out_fd Fd
in_fd Ptr Int64
poff 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
<= -Int64
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, Int64
0)
                else String -> IO (Bool, Int64)
forall a. String -> IO a
throwErrno String
"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 a
x 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
$ String
"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


-- max num of bytes in one send
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" #-}

-- sendfile64 gives LFS support
foreign import ccall unsafe "sendfile64" c_sendfile
    :: Fd -> Fd -> Ptr (Int64) -> (Word64) -> IO (Int64)
{-# LINE 84 "src/Network/Socket/SendFile/Linux.hsc" #-}