wai-app-file-cgi 0.2.2 → 0.2.3

raw patch · 5 files changed

+53/−59 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/Wai/Application/Classic.hs +1/−0
• Network/Wai/Application/Classic/File.hs +42/−37
• Network/Wai/Application/Classic/FileInfo.hs +0/−20
• Network/Wai/Application/Classic/Types.hs +9/−1
• wai-app-file-cgi.cabal +1/−1

@@ -5,6 +5,7 @@ module Network.Wai.Application.Classic (   -- * Types     AppSpec(..)+  , FileInfo(..)   -- * Files   , FileRoute(..), fileApp   -- * CGI

@@ -7,7 +7,7 @@ import Control.Monad.IO.Class (liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString as BS hiding (unpack, pack)-import qualified Data.ByteString.Char8 as BS (unpack, pack)+import qualified Data.ByteString.Char8 as BS (pack) import qualified Data.ByteString.Lazy.Char8 as BL (length) import Network.HTTP.Types import Network.Wai@@ -41,8 +41,8 @@ fileApp :: AppSpec -> FileRoute -> Application fileApp spec filei req = do     RspSpec st hdr body <- case method of-        "GET"  -> processGET  req file ishtml rfile-        "HEAD" -> processHEAD req file ishtml rfile+        "GET"  -> processGET  spec req file ishtml rfile+        "HEAD" -> processHEAD spec req file ishtml rfile         _      -> return notAllowed     let hdr'= addServer hdr         (response, mlen) = case body of@@ -52,11 +52,11 @@                 in (responseLBS st hdr' bd, Just len)             BodyFile afile rng ->                 let (len, mfp) = case rng of-                        Entire bytes    -> (bytes, Nothing)+                        -- sendfile of Linux does not support the entire file+                        Entire bytes    -> (bytes, Just (FilePart 0 bytes))                         Part skip bytes -> (bytes, Just (FilePart skip bytes))                     hdr''  = addLength hdr' len-                    afile' = BS.unpack afile-                in (ResponseFile st hdr'' afile' mfp, Just len)+                in (ResponseFile st hdr'' afile mfp, Just len)     liftIO $ logger spec req st mlen     return response   where@@ -77,55 +77,60 @@  ---------------------------------------------------------------- -processGET :: Request -> ByteString -> Bool -> Maybe ByteString -> Rsp-processGET req file ishtml rfile = runAny [-    tryGet req file ishtml-  , tryRedirect req rfile+processGET :: AppSpec -> Request -> ByteString -> Bool -> Maybe ByteString -> Rsp+processGET spec req file ishtml rfile = runAny [+    tryGet spec req file ishtml+  , tryRedirect spec req rfile   , just notFound   ] -tryGet :: Request -> ByteString -> Bool -> MRsp-tryGet req file True  = runAnyMaybe $ map (tryGetFile req file True) langs+tryGet :: AppSpec -> Request -> ByteString -> Bool -> MRsp+tryGet spec req file True  = runAnyMaybe $ map (tryGetFile spec req file True) langs   where     langs = langSuffixes req-tryGet req file False = tryGetFile req file False Nothing+tryGet spec req file False = tryGetFile spec req file False Nothing -tryGetFile :: Request -> ByteString -> Bool -> Lang -> MRsp-tryGetFile req file ishtml mlang = do+tryGetFile :: AppSpec -> Request -> ByteString -> Bool -> Lang -> MRsp+tryGetFile spec req file ishtml mlang = do     let file' = maybe file (file +++) mlang-    liftIO (fileInfo file') |>| \(size, mtime) -> do-      let hdr = newHeader ishtml file mtime+    liftIO (getFileInfo spec file') |>| \finfo -> do+      let mtime = fileInfoTime finfo+          size = fileInfoSize finfo+          sfile = fileInfoName finfo+          hdr = newHeader ishtml file mtime           Just pst = ifmodified req size mtime -- never Nothing                  ||| ifunmodified req size mtime                  ||| ifrange req size mtime                  ||| unconditional req size mtime       case pst of           Full st-            | st == statusOK -> just $ RspSpec statusOK hdr (BodyFile file' (Entire size))+            | st == statusOK -> just $ RspSpec statusOK hdr (BodyFile sfile (Entire size))             | otherwise      -> just $ RspSpec st hdr NoBody -          Partial skip len   -> just $ RspSpec statusPartialContent hdr (BodyFile file' (Part skip len))+          Partial skip len   -> just $ RspSpec statusPartialContent hdr (BodyFile sfile (Part skip len))  ---------------------------------------------------------------- -processHEAD :: Request -> ByteString -> Bool -> Maybe ByteString -> Rsp-processHEAD req file ishtml rfile = runAny [-    tryHead req file ishtml-  , tryRedirect req rfile+processHEAD :: AppSpec -> Request -> ByteString -> Bool -> Maybe ByteString -> Rsp+processHEAD spec req file ishtml rfile = runAny [+    tryHead spec req file ishtml+  , tryRedirect spec req rfile   , just notFound   ] -tryHead :: Request -> ByteString -> Bool -> MRsp-tryHead req file True  = runAnyMaybe $ map (tryHeadFile req file True) langs+tryHead :: AppSpec -> Request -> ByteString -> Bool -> MRsp+tryHead spec req file True  = runAnyMaybe $ map (tryHeadFile spec req file True) langs   where     langs = langSuffixes req-tryHead req file False= tryHeadFile req file False Nothing+tryHead spec req file False= tryHeadFile spec req file False Nothing -tryHeadFile :: Request -> ByteString -> Bool -> Lang -> MRsp-tryHeadFile req file ishtml mlang = do+tryHeadFile :: AppSpec -> Request -> ByteString -> Bool -> Lang -> MRsp+tryHeadFile spec req file ishtml mlang = do     let file' = maybe file (file +++) mlang-    liftIO (fileInfo file') |>| \(size, mtime) -> do-      let hdr = newHeader ishtml file mtime+    liftIO (getFileInfo spec file') |>| \finfo -> do+      let mtime = fileInfoTime finfo+          size = fileInfoSize finfo+          hdr = newHeader ishtml file mtime           Just pst = ifmodified req size mtime -- never Nothing                  ||| Just (Full statusOK)       case pst of@@ -134,17 +139,17 @@  ---------------------------------------------------------------- -tryRedirect  :: Request -> Maybe ByteString -> MRsp-tryRedirect _   Nothing     = nothing-tryRedirect req (Just file) =-    runAnyMaybe $ map (tryRedirectFile req file) langs+tryRedirect  :: AppSpec -> Request -> Maybe ByteString -> MRsp+tryRedirect _ _ Nothing = nothing+tryRedirect spec req (Just file) =+    runAnyMaybe $ map (tryRedirectFile spec req file) langs   where     langs = langSuffixes req -tryRedirectFile :: Request -> ByteString -> Lang -> MRsp-tryRedirectFile req file mlang = do+tryRedirectFile :: AppSpec -> Request -> ByteString -> Lang -> MRsp+tryRedirectFile spec req file mlang = do     let file' = maybe file (file +++) mlang-    minfo <- liftIO $ fileInfo file'+    minfo <- liftIO $ getFileInfo spec file'     case minfo of       Nothing -> nothing       Just _  -> just $ RspSpec statusMovedPermanently hdr NoBody

@@ -1,9 +1,7 @@ module Network.Wai.Application.Classic.FileInfo where -import Control.Exception import Data.ByteString (ByteString) import qualified Data.ByteString as BS hiding (unpack)-import qualified Data.ByteString.Char8 as BS (unpack) import Network.HTTP.Date import Network.HTTP.Types import Network.Wai@@ -12,24 +10,6 @@ import Network.Wai.Application.Classic.Range import Network.Wai.Application.Classic.Types import Network.Wai.Application.Classic.Utils-import System.Posix.Files---------------------------------------------------------------------- This function is slow.--- So, let's avoid using doesFileExist which uses getFilesStatus.-fileInfo :: ByteString -> IO (Maybe (Integer, HTTPDate))-fileInfo file = handle nothing $ do-    fs <- getFileStatus (BS.unpack file)-    if doesExist fs-       then return $ Just (size fs, mtime fs)-       else return Nothing-  where-    nothing :: IOException -> IO (Maybe (Integer, HTTPDate))-    nothing _ = return Nothing-    size = fromIntegral . fileSize-    mtime = epochTimeToHTTPDate . modificationTime-    doesExist = not . isDirectory  ---------------------------------------------------------------- 

@@ -2,6 +2,7 @@  import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)+import Network.HTTP.Date import Network.HTTP.Types import Network.Wai @@ -14,8 +15,15 @@   , isHTML :: ByteString -> Bool     -- | A function for logging. The third argument is a body size.   , logger :: Request -> Status -> Maybe Integer -> IO ()+  , getFileInfo :: ByteString -> IO (Maybe FileInfo)   } +data FileInfo = FileInfo {+    fileInfoName :: FilePath+  , fileInfoSize :: Integer+  , fileInfoTime :: HTTPDate+  }+ data FileRoute = FileRoute {     -- | Path prefix to be matched to 'pathInfo'.     fileSrc :: ByteString@@ -45,7 +53,7 @@     -- | Body as Lazy ByteString.   | BodyLBS BL.ByteString     -- | Body as a file.-  | BodyFile ByteString Range+  | BodyFile String Range  data Range =     -- | Entire file showing its file size

@@ -1,5 +1,5 @@ Name:                   wai-app-file-cgi-Version:                0.2.2+Version:                0.2.3 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3