{-# LANGUAGE CPP #-}
module Network.Socket.SendFile.Portable 
     ( sendFile
     , sendFileIterWith
     , sendFile'
     , sendFileIterWith'
     , sendFile''
     , sendFileIterWith''
     , unsafeSendFile
     , unsafeSendFileIterWith
     , unsafeSendFile'
     , unsafeSendFile''
     , unsafeSendFileIterWith'
     , unsafeSendFileIterWith''
     , sendFileMode
     )
    where

import Data.ByteString.Char8 (hGet, hPut, length, ByteString)
import qualified Data.ByteString.Char8 as C
import Network.Socket.ByteString (send)
import Network.Socket (Socket(..), fdSocket)
import Network.Socket.SendFile.Iter (Iter(..), runIter)
import Network.Socket.SendFile.Util (wrapSendFile')
import Prelude hiding (length)
import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hFlush, hIsEOF, hSeek, withBinaryFile)
import System.Posix.Types (Fd(..))
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__ >= 611
import System.IO.Error
#endif
#endif 


sendFileMode :: String
sendFileMode :: String
sendFileMode = "PORTABLE_SENDFILE"

sendFileIterWith'' :: (IO Iter -> IO a) -> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
sendFileIterWith'' :: (IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
sendFileIterWith'' stepper :: IO Iter -> IO a
stepper =
    (Socket -> Handle -> Integer -> Integer -> Integer -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
forall i a b c.
Integral i =>
(a -> b -> i -> i -> i -> IO c)
-> a -> b -> Integer -> Integer -> Integer -> IO c
wrapSendFile' ((Socket -> Handle -> Integer -> Integer -> Integer -> IO a)
 -> Socket -> Handle -> Integer -> Integer -> Integer -> IO a)
-> (Socket -> Handle -> Integer -> Integer -> Integer -> IO a)
-> Socket
-> Handle
-> Integer
-> Integer
-> Integer
-> IO a
forall a b. (a -> b) -> a -> b
$ \outs :: Socket
outs inp :: Handle
inp blockSize :: Integer
blockSize off :: Integer
off count :: Integer
count ->
        do Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
inp SeekMode
AbsoluteSeek Integer
off
           IO Iter -> IO a
stepper (Socket
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
sendFileIterS Socket
outs Handle
inp Integer
blockSize {- off -} Integer
count Maybe ByteString
forall a. Maybe a
Nothing)

sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO ()
sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO ()
sendFile'' outs :: Socket
outs inh :: Handle
inh off :: Integer
off count :: Integer
count =
    do Int64
_ <- (IO Iter -> IO Int64)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO Int64
forall a.
(IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
sendFileIterWith'' IO Iter -> IO Int64
runIter Socket
outs Handle
inh Integer
count Integer
off Integer
count
       () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

unsafeSendFileIterWith'' :: (IO Iter -> IO a) -> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' :: (IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' stepper :: IO Iter -> IO a
stepper =
    (Handle -> Handle -> Integer -> Integer -> Integer -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
forall i a b c.
Integral i =>
(a -> b -> i -> i -> i -> IO c)
-> a -> b -> Integer -> Integer -> Integer -> IO c
wrapSendFile' ((Handle -> Handle -> Integer -> Integer -> Integer -> IO a)
 -> Handle -> Handle -> Integer -> Integer -> Integer -> IO a)
-> (Handle -> Handle -> Integer -> Integer -> Integer -> IO a)
-> Handle
-> Handle
-> Integer
-> Integer
-> Integer
-> IO a
forall a b. (a -> b) -> a -> b
$ \outp :: Handle
outp inp :: Handle
inp blockSize :: Integer
blockSize off :: Integer
off count :: Integer
count ->
        do Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
inp SeekMode
AbsoluteSeek Integer
off
           a
a <- IO Iter -> IO a
stepper (Handle
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
unsafeSendFileIter Handle
outp Handle
inp Integer
blockSize Integer
count Maybe ByteString
forall a. Maybe a
Nothing)
           Handle -> IO ()
hFlush Handle
outp
           a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' outh :: Handle
outh inh :: Handle
inh off :: Integer
off count :: Integer
count =
    do Int64
_ <- (IO Iter -> IO Int64)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO Int64
forall a.
(IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' IO Iter -> IO Int64
runIter Handle
outh Handle
inh Integer
count Integer
off Integer
count
       () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

sendFileIterS :: Socket  -- ^ output network socket
             -> Handle  -- ^ input handle
             -> Integer -- ^ maximum number of bytes to send at once
             -> Integer -- ^ total number of bytes to send
             -> Maybe ByteString
             -> IO Iter
sendFileIterS :: Socket
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
sendFileIterS _socket :: Socket
_socket _inh :: Handle
_inh _blockSize :: Integer
_blockSize {- _off -} 0        _    = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done 0)
sendFileIterS socket :: Socket
socket   inh :: Handle
inh  blockSize :: Integer
blockSize {- off -} remaining :: Integer
remaining mBuf :: Maybe ByteString
mBuf =
    do ByteString
buf <- IO ByteString
nextBlock
       Int
nsent <- Socket -> ByteString -> IO Int
send Socket
socket ByteString
buf
       let leftOver :: Maybe ByteString
leftOver =
               if Int
nsent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (ByteString -> Int
C.length ByteString
buf)
                  then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
C.drop Int
nsent ByteString
buf)
                  else Maybe ByteString
forall a. Maybe a
Nothing
       let cont :: IO Iter
cont = Socket
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
sendFileIterS Socket
socket Handle
inh Integer
blockSize {- (off + (fromIntegral nsent)) -} (Integer
remaining Integer -> Integer -> Integer
forall a. (Show a, Ord a, Num a) => a -> a -> a
`safeMinus` (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent)) Maybe ByteString
leftOver
       if Int
nsent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (ByteString -> Int
length ByteString
buf)
#if MIN_VERSION_network(3,0,0)
          then do CInt
fd <- Socket -> IO CInt
fdSocket Socket
socket
                  Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Fd -> IO Iter -> Iter
WouldBlock (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent) (CInt -> Fd
Fd CInt
fd) IO Iter
cont)
#else
          then return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont)
#endif
          else Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent       (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent)                        IO Iter
cont)
    where
   nextBlock :: IO ByteString
nextBlock =
          case Maybe ByteString
mBuf of
            (Just b :: ByteString
b) -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Nothing ->
                do Bool
eof <- Handle -> IO Bool
hIsEOF Handle
inh
                   if Bool
eof
                    then IOError -> IO ByteString
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType ("Reached EOF but was hoping to read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
remaining String -> String -> String
forall a. [a] -> [a] -> [a]
++ " more byte(s).") (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
inh) Maybe String
forall a. Maybe a
Nothing)
                    else do let bytes :: Integer
bytes = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min 32768 (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
blockSize Integer
remaining)
                            Handle -> Int -> IO ByteString
hGet Handle
inh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bytes) -- we could check that we got fewer bytes than requested here, but we will send what we got and catch the EOF next time around

safeMinus :: (Show a, Ord a, Num 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

unsafeSendFileIter :: Handle  -- ^ output handle
                   -> Handle  -- ^ input handle
                   -> Integer -- ^ maximum number of bytes to send at once
--                   -> Integer -- ^ offset into file
                   -> Integer -- ^ total number of bytes to send
                   -> Maybe ByteString
                   -> IO Iter
unsafeSendFileIter :: Handle
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
unsafeSendFileIter _outh :: Handle
_outh _inh :: Handle
_inh _blockSize :: Integer
_blockSize 0         _mBuf :: Maybe ByteString
_mBuf = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done 0)
unsafeSendFileIter  outh :: Handle
outh  inh :: Handle
inh  blockSize :: Integer
blockSize remaining :: Integer
remaining  mBuf :: Maybe ByteString
mBuf =
    do ByteString
buf <- IO ByteString
nextBlock
       Handle -> ByteString -> IO ()
hPut Handle
outh ByteString
buf -- eventually this should use a non-blocking version of hPut
       let nsent :: Int
nsent = ByteString -> Int
length ByteString
buf
{-
           leftOver =
               if nsent < (C.length buf)
                  then Just (C.drop nsent buf)
                  else Nothing
-}
           cont :: IO Iter
cont = Handle
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
unsafeSendFileIter Handle
outh Handle
inh Integer
blockSize {- (off + (fromIntegral nsent)) -} (Integer
remaining Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent)) Maybe ByteString
forall a. Maybe a
Nothing
       if Int
nsent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (ByteString -> Int
length ByteString
buf)
          then do String -> IO Iter
forall a. HasCallStack => String -> a
error "unsafeSendFileIter: internal error" -- return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont)
          else Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent) IO Iter
cont)
    where
      nextBlock :: IO ByteString
nextBlock =
          case Maybe ByteString
mBuf of
            (Just b :: ByteString
b) -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Nothing ->
                do Bool
eof <- Handle -> IO Bool
hIsEOF Handle
inh
                   if Bool
eof
                    then IOError -> IO ByteString
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType ("Reached EOF but was hoping to read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
remaining String -> String -> String
forall a. [a] -> [a] -> [a]
++ " more byte(s).") (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
inh) Maybe String
forall a. Maybe a
Nothing)
                    else do let bytes :: Integer
bytes = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min 32768 (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
blockSize Integer
remaining)
                            Handle -> Int -> IO ByteString
hGet Handle
inh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bytes) -- we could check that we got fewer bytes than requested here, but we will send what we got and catch the EOF next time around

-- copied from Internal.hs -- not sure how to avoid having two copies of this code yet

sendFile :: Socket -> FilePath -> IO ()
sendFile :: Socket -> String -> IO ()
sendFile outs :: Socket
outs infp :: String
infp =
    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      Socket -> Handle -> Integer -> Integer -> IO ()
sendFile'' Socket
outs Handle
inp 0 Integer
count

sendFileIterWith :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> IO a
sendFileIterWith :: (IO Iter -> IO a) -> Socket -> String -> Integer -> IO a
sendFileIterWith stepper :: IO Iter -> IO a
stepper outs :: Socket
outs infp :: String
infp blockSize :: Integer
blockSize =
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      (IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
forall a.
(IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
sendFileIterWith'' IO Iter -> IO a
stepper Socket
outs Handle
inp Integer
blockSize 0 Integer
count

sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO ()
sendFile' :: Socket -> String -> Integer -> Integer -> IO ()
sendFile' outs :: Socket
outs infp :: String
infp offset :: Integer
offset count :: Integer
count =
    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp ->
        Socket -> Handle -> Integer -> Integer -> IO ()
sendFile'' Socket
outs Handle
inp Integer
offset Integer
count

sendFileIterWith' :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> Integer -> Integer -> IO a
sendFileIterWith' :: (IO Iter -> IO a)
-> Socket -> String -> Integer -> Integer -> Integer -> IO a
sendFileIterWith' stepper :: IO Iter -> IO a
stepper outs :: Socket
outs infp :: String
infp blockSize :: Integer
blockSize offset :: Integer
offset count :: Integer
count =
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp ->
        (IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
forall a.
(IO Iter -> IO a)
-> Socket -> Handle -> Integer -> Integer -> Integer -> IO a
sendFileIterWith'' IO Iter -> IO a
stepper Socket
outs Handle
inp Integer
blockSize Integer
offset Integer
count

unsafeSendFile :: Handle -> FilePath -> IO ()
unsafeSendFile :: Handle -> String -> IO ()
unsafeSendFile outp :: Handle
outp infp :: String
infp =
    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' Handle
outp Handle
inp 0 Integer
count

unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> FilePath -> Integer -> IO a
unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> String -> Integer -> IO a
unsafeSendFileIterWith stepper :: IO Iter -> IO a
stepper outp :: Handle
outp infp :: String
infp blockSize :: Integer
blockSize =
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      (IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
forall a.
(IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' IO Iter -> IO a
stepper Handle
outp Handle
inp Integer
blockSize 0 Integer
count


unsafeSendFile'
    :: Handle    -- ^ The output handle
    -> FilePath  -- ^ The input filepath
    -> Integer    -- ^ The offset to start at
    -> Integer -- ^ The number of bytes to send
    -> IO ()
unsafeSendFile' :: Handle -> String -> Integer -> Integer -> IO ()
unsafeSendFile' outp :: Handle
outp infp :: String
infp offset :: Integer
offset count :: Integer
count =
    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' Handle
outp Handle
inp Integer
offset Integer
count

unsafeSendFileIterWith'
    :: (IO Iter -> IO a)
    -> Handle    -- ^ The output handle
    -> FilePath  -- ^ The input filepath
    -> Integer   -- ^ maximum block size
    -> Integer   -- ^ The offset to start at
    -> Integer   -- ^ The number of bytes to send
    -> IO a
unsafeSendFileIterWith' :: (IO Iter -> IO a)
-> Handle -> String -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith' stepper :: IO Iter -> IO a
stepper outp :: Handle
outp infp :: String
infp blockSize :: Integer
blockSize offset :: Integer
offset count :: Integer
count =
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \inp :: Handle
inp -> do
      (IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
forall a.
(IO Iter -> IO a)
-> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' IO Iter -> IO a
stepper Handle
outp Handle
inp Integer
blockSize Integer
offset Integer
count