{-# 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 =
    forall i a b c.
Integral i =>
(a -> b -> i -> i -> i -> IO c)
-> a -> b -> Integer -> Integer -> Integer -> IO c
wrapSendFile' 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 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
_ <- 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
       forall (m :: * -> *) a. Monad m => a -> m a
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 =
    forall i a b c.
Integral i =>
(a -> b -> i -> i -> i -> IO c)
-> a -> b -> Integer -> Integer -> Integer -> IO c
wrapSendFile' 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 forall a. Maybe a
Nothing)
           Handle -> IO ()
hFlush Handle
outp
           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
_ <- 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
       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
_    = 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 forall a. Ord a => a -> a -> Bool
< (ByteString -> Int
C.length ByteString
buf)
                  then forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
C.drop Int
nsent ByteString
buf)
                  else 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 forall a. (Show a, Ord a, Num a) => a -> a -> a
`safeMinus` (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent)) Maybe ByteString
leftOver
       if Int
nsent 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Fd -> IO Iter -> Iter
WouldBlock (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 forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent       (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) -> 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 forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType (String
"Reached EOF but was hoping to read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
remaining forall a. [a] -> [a] -> [a]
++ String
" more byte(s).") (forall a. a -> Maybe a
Just Handle
inh) forall a. Maybe a
Nothing)
                    else do let bytes :: Integer
bytes = forall a. Ord a => a -> a -> a
min Integer
32768 (forall a. Ord a => a -> a -> a
min Integer
blockSize Integer
remaining)
                            Handle -> Int -> IO ByteString
hGet Handle
inh (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 :: forall a. (Show a, Ord a, Num a) => a -> a -> a
safeMinus a
x a
y
    | a
y forall a. Ord a => a -> a -> Bool
> a
x = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"y > x " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (a
y,a
x)
    | Bool
otherwise = a
x 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 = 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 forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsent)) forall a. Maybe a
Nothing
       if Int
nsent forall a. Ord a => a -> a -> Bool
< (ByteString -> Int
length ByteString
buf)
          then do forall a. HasCallStack => String -> a
error String
"unsafeSendFileIter: internal error" -- return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont)
          else forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Iter -> Iter
Sent (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) -> 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 forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType (String
"Reached EOF but was hoping to read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
remaining forall a. [a] -> [a] -> [a]
++ String
" more byte(s).") (forall a. a -> Maybe a
Just Handle
inh) forall a. Maybe a
Nothing)
                    else do let bytes :: Integer
bytes = forall a. Ord a => a -> a -> a
min Integer
32768 (forall a. Ord a => a -> a -> a
min Integer
blockSize Integer
remaining)
                            Handle -> Int -> IO ByteString
hGet Handle
inh (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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode 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 :: forall a. (IO Iter -> IO a) -> Socket -> String -> Integer -> IO a
sendFileIterWith IO Iter -> IO a
stepper Socket
outs String
infp Integer
blockSize =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode 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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
inp ->
        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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode 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 :: forall a. (IO Iter -> IO a) -> Handle -> String -> Integer -> IO a
unsafeSendFileIterWith IO Iter -> IO a
stepper Handle
outp String
infp Integer
blockSize =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
inp -> do
      Integer
count <- Handle -> IO Integer
hFileSize Handle
inp
      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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode 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 =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
infp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
inp -> do
      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