1{-# LANGUAGE CPP #-}
2module Network.Sendfile.Fallback (
3    sendfile
4  , sendfileWithHeader
5  ) where
6
7import Control.Monad.IO.Class (MonadIO(liftIO))
8import Data.ByteString (ByteString)
9import Data.Conduit
10import Data.Conduit.Binary as EB
11import Network.Sendfile.Types
12import Network.Socket
13import Network.Socket.ByteString
14import qualified Network.Socket.ByteString as SB
15import Control.Monad.Trans.Resource (runResourceT)
16
17-- |
18-- Sendfile emulation using conduit.
19-- Used system calls:
20--
21--  - Used system calls: open(), stat(), read(), send() and close().
22
23sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()
24sendfile sock path EntireFile hook =
25    runResourceT $ sourceFile path $$ sinkSocket sock hook
26sendfile sock path (PartOfFile off len) hook =
27    runResourceT $ EB.sourceFileRange path (Just off) (Just len) $$ sinkSocket sock hook
28
29-- See sinkHandle.
30sinkSocket :: MonadIO m => Socket -> IO () -> Sink ByteString m ()
31#if MIN_VERSION_conduit(0,5,0)
32sinkSocket s hook = awaitForever $ \bs -> liftIO $ SB.sendAll s bs >> hook
33#else
34sinkSocket s hook = NeedInput push close
35  where
36    push bs = flip PipeM (return ()) $ do
37        liftIO (SB.sendAll s bs)
38        liftIO hook
39        return (NeedInput push close)
40    close = return ()
41#endif
42
43-- |
44-- Sendfile emulation using conduit.
45-- Used system calls:
46--
47--  - Used system calls: open(), stat(), read(), writev(), send() and close().
48
49sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString] -> IO ()
50sendfileWithHeader sock path range hook hdr = do
51    sendMany sock hdr
52    sendfile sock path range hook
53