{-# 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 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
-> Handle
-> Integer
-> Integer
-> Maybe ByteString
-> IO Iter
sendFileIterS :: Socket
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
sendFileIterS _socket :: Socket
_socket _inh :: Handle
_inh _blockSize :: Integer
_blockSize 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 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 (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)
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
-> Handle
-> Integer
-> Integer
-> 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
let nsent :: Int
nsent = ByteString -> Int
length ByteString
buf
cont :: IO Iter
cont = Handle
-> Handle -> Integer -> Integer -> Maybe ByteString -> IO Iter
unsafeSendFileIter Handle
outh Handle
inh Integer
blockSize (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"
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)
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
-> FilePath
-> Integer
-> Integer
-> 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
-> FilePath
-> Integer
-> Integer
-> Integer
-> 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