{-# 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'' :: forall a.
(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 _ <- (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
       return ()

unsafeSendFileIterWith'' :: (IO Iter -> IO a) -> Handle -> Handle -> Integer -> Integer -> Integer -> IO a
unsafeSendFileIterWith'' :: forall a.
(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 <- 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)
           hFlush outp
           return a

unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()
unsafeSendFile'' Handle
outh Handle
inh Integer
off Integer
count =
    do _ <- (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
       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 a. a -> IO a
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 buf <- IO ByteString
nextBlock
       nsent <- send socket buf
       let 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 = 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 nsent < (length buf)
#if MIN_VERSION_network(3,0,0)
          then do fd <- fdSocket socket
                  return (WouldBlock (fromIntegral nsent) (Fd fd) cont)
#else
          then return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont)
#endif
          else return (Sent       (fromIntegral nsent)                        cont)
    where
   nextBlock :: IO ByteString
nextBlock =
          case Maybe ByteString
mBuf of
            (Just ByteString
b) -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Maybe ByteString
Nothing ->
                do eof <- Handle -> IO Bool
hIsEOF Handle
inh
                   if eof
                    then ioError (mkIOError eofErrorType ("Reached EOF but was hoping to read " ++ show remaining ++ " more byte(s).") (Just inh) Nothing)
                    else do let 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)
                            hGet inh (fromIntegral 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 :: forall a. (Show a, Ord a, Num a) => 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 a. a -> IO a
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 buf <- IO ByteString
nextBlock
       hPut outh buf -- eventually this should use a non-blocking version of hPut
       let nsent = ByteString -> Int
length ByteString
buf
{-
           leftOver =
               if nsent < (C.length buf)
                  then Just (C.drop nsent buf)
                  else Nothing
-}
           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 nsent < (length buf)
          then do error "unsafeSendFileIter: internal error" -- return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont)
          else return (Sent (fromIntegral nsent) cont)
    where
      nextBlock :: IO ByteString
nextBlock =
          case Maybe ByteString
mBuf of
            (Just ByteString
b) -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            Maybe ByteString
Nothing ->
                do eof <- Handle -> IO Bool
hIsEOF Handle
inh
                   if eof
                    then ioError (mkIOError eofErrorType ("Reached EOF but was hoping to read " ++ show remaining ++ " more byte(s).") (Just inh) Nothing)
                    else do let 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)
                            hGet inh (fromIntegral 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
      count <- Handle -> IO Integer
hFileSize Handle
inp
      sendFile'' outs inp 0 count

sendFileIterWith :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> IO a
sendFileIterWith :: forall a. (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
      count <- Handle -> IO Integer
hFileSize Handle
inp
      sendFileIterWith'' stepper outs inp blockSize 0 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' :: forall a.
(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
      count <- Handle -> IO Integer
hFileSize Handle
inp
      unsafeSendFile'' outp inp 0 count

unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> FilePath -> Integer -> IO a
unsafeSendFileIterWith :: forall a. (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
      count <- Handle -> IO Integer
hFileSize Handle
inp
      unsafeSendFileIterWith'' stepper outp inp blockSize 0 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' :: forall a.
(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