{-# 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 = String
"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'' 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
$ \Socket
outs Handle
inp Integer
blockSize Integer
off 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'' Socket
outs Handle
inh Integer
off 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'' 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
$ \Handle
outp Handle
inp Integer
blockSize Integer
off 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'' Handle
outh Handle
inh Integer
off 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 Handle
_inh Integer
_blockSize {- _off -} Integer
0        Maybe ByteString
_    = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done Int64
0)
sendFileIterS Socket
socket   Handle
inh  Integer
blockSize {- off -} Integer
remaining 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 ByteString
b) -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Maybe ByteString
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 (String
"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]
++ String
" 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 Integer
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 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

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 Handle
_outh Handle
_inh Integer
_blockSize Integer
0         Maybe ByteString
_mBuf = Iter -> IO Iter
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Iter
Done Int64
0)
unsafeSendFileIter  Handle
outh  Handle
inh  Integer
blockSize Integer
remaining  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 String
"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 ByteString
b) -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Maybe ByteString
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 (String
"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]
++ String
" 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 Integer
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 Socket
outs 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
$ \Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      Socket -> Handle -> Integer -> Integer -> IO ()
sendFile'' Socket
outs Handle
inp Integer
0 Integer
count

sendFileIterWith :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> IO a
sendFileIterWith :: (IO Iter -> IO a) -> Socket -> String -> Integer -> IO a
sendFileIterWith IO Iter -> IO a
stepper Socket
outs String
infp 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
$ \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 Integer
0 Integer
count

sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO ()
sendFile' :: Socket -> String -> Integer -> Integer -> IO ()
sendFile' Socket
outs String
infp Integer
offset 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
$ \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' IO Iter -> IO a
stepper Socket
outs String
infp Integer
blockSize Integer
offset 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
$ \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 Handle
outp 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
$ \Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' Handle
outp Handle
inp Integer
0 Integer
count

unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> FilePath -> Integer -> IO a
unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> String -> Integer -> IO a
unsafeSendFileIterWith IO Iter -> IO a
stepper Handle
outp String
infp 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
$ \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 Integer
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' Handle
outp String
infp Integer
offset 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
$ \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' IO Iter -> IO a
stepper Handle
outp String
infp Integer
blockSize Integer
offset 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
$ \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