-- |
--
-- Since 3.0.4
module Network.Wai.Middleware.StreamFile
    (streamFile) where

import Network.Wai (responseStream)
import Network.Wai.Internal
import Network.Wai (Middleware, responseToStream)
import qualified Data.ByteString.Char8 as S8
import System.Directory (getFileSize)
import Network.HTTP.Types (hContentLength)

-- |Convert ResponseFile type responses into ResponseStream type
--
-- Checks the response type, and if it's a ResponseFile, converts it
-- into a ResponseStream. Other response types are passed through
-- unchanged.
--
-- Converted responses get a Content-Length header.
--
-- Streaming a file will bypass a sendfile system call, and may be
-- useful to work around systems without working sendfile
-- implementations.
--
-- Since 3.0.4
streamFile :: Middleware
streamFile :: Middleware
streamFile Application
app Request
env Response -> IO ResponseReceived
sendResponse = Application
app Request
env ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res ->
    case Response
res of
      ResponseFile Status
_ ResponseHeaders
_ FilePath
fp Maybe FilePart
_ -> (StreamingBody -> IO ResponseReceived) -> IO ResponseReceived
forall a. (StreamingBody -> IO a) -> IO a
withBody StreamingBody -> IO ResponseReceived
sendBody
          where
            (Status
s, ResponseHeaders
hs, (StreamingBody -> IO a) -> IO a
withBody) = Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream Response
res
            sendBody :: StreamingBody -> IO ResponseReceived
            sendBody :: StreamingBody -> IO ResponseReceived
sendBody StreamingBody
body = do
               Integer
len <- FilePath -> IO Integer
getFileSize FilePath
fp
               let hs' :: ResponseHeaders
hs' = (HeaderName
hContentLength, (FilePath -> ByteString
S8.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
len))) (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hs
               Response -> IO ResponseReceived
sendResponse (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> StreamingBody -> Response
responseStream Status
s ResponseHeaders
hs' StreamingBody
body
      Response
_ -> Response -> IO ResponseReceived
sendResponse Response
res