1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.HTTP.File 3 ( fileResponse 4 , serveFile 5 ) where 6 7 import Control.Monad (when) 8 import Control.Monad.IO.Class (liftIO) 9 import qualified Data.ByteString as BS 10 import Data.Monoid ((<>)) 11 import Network.HTTP.Types (ResponseHeaders, hLastModified, hContentType, hCacheControl, hIfModifiedSince, notModified304, hIfRange) 12 import System.Posix.Types (FileOffset) 13 14 import Databrary.Ops 15 import Databrary.Has 16 import Databrary.Files 17 import Databrary.HTTP.Request 18 import Databrary.HTTP 19 import Databrary.Action 20 import Databrary.Model.Format 21 22 fileResponse :: RawFilePath -> Format -> Maybe BS.ByteString -> BS.ByteString -> Handler (ResponseHeaders, Maybe FileOffset) 23 fileResponse file fmt save etag = do 24 (sz, mt) <- maybeAction =<< liftIO (fileInfo file) 25 let fh = 26 [ ("etag", quoteHTTP etag) 27 , (hLastModified, formatHTTPTimestamp mt) 28 , (hContentType, formatMimeType fmt) 29 , ("content-disposition", maybe "inline" (\n -> "attachment; filename=" 30 <> quoteHTTP (addFormatExtension n fmt)) save) 31 , (hCacheControl, "max-age=31556926, private") 32 ] 33 req <- peek 34 let ifnm = map unquoteHTTP $ (splitHTTP =<<) $ lookupRequestHeaders "if-none-match" req 35 notmod 36 | null ifnm = any (mt <=) $ (parseHTTPTimestamp =<<) $ lookupRequestHeader hIfModifiedSince req 37 | otherwise = any (\m -> m == "*" || m == etag) ifnm 38 when notmod $ result $ emptyResponse notModified304 fh 39 return (fh, 40 -- allow range detection or force full file: 41 (any ((etag /=) . unquoteHTTP) (lookupRequestHeader hIfRange req)) `thenUse` sz) 42 43 serveFile :: RawFilePath -> Format -> Maybe BS.ByteString -> BS.ByteString -> Handler Response 44 serveFile file fmt save etag = do 45 (h, part) <- fileResponse file fmt save etag 46 fp <- liftIO $ unRawFilePath file 47 return $ okResponse h (fp, part)