1 {-# LANGUAGE OverloadedStrings #-} 2 module 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 Ops 15 import Has 16 import Files 17 import HTTP.Request 18 import HTTP 19 import Action 20 import 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)