wai-app-file-cgi 3.0.8 → 3.0.9
raw patch · 6 files changed
+42/−50 lines, 6 filesdep ~waidep ~warp
Dependency ranges changed: wai, warp
Files
- Network/Wai/Application/Classic.hs +0/−1
- Network/Wai/Application/Classic/Def.hs +1/−22
- Network/Wai/Application/Classic/File.hs +12/−9
- Network/Wai/Application/Classic/Status.hs +11/−7
- Network/Wai/Application/Classic/Types.hs +14/−8
- wai-app-file-cgi.cabal +4/−3
Network/Wai/Application/Classic.hs view
@@ -12,7 +12,6 @@ -- * Files , FileAppSpec(..) , defaultFileAppSpec- , FileInfo(..) , FileRoute(..) , fileApp -- * Redirect
Network/Wai/Application/Classic/Def.hs view
@@ -2,13 +2,10 @@ module Network.Wai.Application.Classic.Def where -import Control.Exception-import Network.HTTP.Date import Network.HTTP.Types import Network.Wai import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types-import System.Posix -- | -- Default value for 'ClassicAppSpec'. 'softwareName' is \"Classic\". 'logger' does not log at all. 'dater' calls 'epochTime' for every request. 'statusFileDir' is \"\/usr\/local\/share\/html\/status\/\".@@ -25,33 +22,15 @@ ---------------------------------------------------------------- -- |--- Default value for 'defaultFileAppSpec'. 'indexFile' is \"index.html\". 'isHTML' matches \"*.html\" and \"*.html\". 'getFileInfo' calls `getFileStatus` for every request.+-- Default value for 'defaultFileAppSpec'. 'indexFile' is \"index.html\". 'isHTML' matches \"*.html\" and \"*.html\". defaultFileAppSpec :: FileAppSpec defaultFileAppSpec = FileAppSpec { indexFile = "index.html" , isHTML = defaultIsHTml- , getFileInfo = defaultGetFileInfo } defaultIsHTml :: Path -> Bool defaultIsHTml file = ".html" `isSuffixOf` file || ".htm" `isSuffixOf` file--defaultGetFileInfo :: Path -> IO FileInfo-defaultGetFileInfo path = do- fs <- getFileStatus sfile- if not (isDirectory fs) then- return FileInfo {- fileInfoName = path- , fileInfoSize = size fs- , fileInfoTime = time fs- , fileInfoDate = formatHTTPDate (time fs)- }- else- throwIO $ userError "does not exist"- where- sfile = pathString path- size = fromIntegral . fileSize- time = epochTimeToHTTPDate . modificationTime ----------------------------------------------------------------
Network/Wai/Application/Classic/File.hs view
@@ -21,6 +21,7 @@ import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Status import Network.Wai.Application.Classic.Types+import Network.Wai.Handler.Warp (getFileInfo) ---------------------------------------------------------------- @@ -79,7 +80,7 @@ rfile = redirectPath spec path langs = langSuffixes reqidx noBody st = return (responseLBS st [] "", Nothing)- bodyStatus st = liftIO (getStatusInfo cspec spec langs st)+ bodyStatus st = liftIO (getStatusInfo cspec req langs st) >>= statusBody st statusBody st StatusNone = noBody st statusBody st (StatusByteString bd) =@@ -117,12 +118,13 @@ tryGet hinfo False = tryGetFile hinfo False id tryGetFile :: HandlerInfo -> Bool -> Lang -> Rsp-tryGetFile (HandlerInfo spec req reqidx file _) ishtml lang = do- finfo <- liftIO $ getFileInfo spec (lang file)- let mtime = fileInfoTime finfo- size = fileInfoSize finfo- sfile = fileInfoName finfo- date = fileInfoDate finfo+tryGetFile (HandlerInfo _ req reqidx file _) ishtml lang = do+ let file' = pathString $ lang file+ finfo <- fromFileInfo <$> liftIO (getFileInfo req file')+ let mtime = fileinfoTime finfo+ size = fileinfoSize finfo+ sfile = fileinfoName finfo+ date = fileinfoDate finfo mrange = requestHeaderRange req hdr = newHeader ishtml (pathByteString file) date Just pst = ifmodified reqidx size mtime mrange@@ -145,8 +147,9 @@ hinfo = HandlerInfo spec req reqidx file langs tryRedirectFile :: HandlerInfo -> Lang -> Rsp-tryRedirectFile (HandlerInfo spec req _ file _) lang = do- _ <- liftIO $ getFileInfo spec (lang file)+tryRedirectFile (HandlerInfo _ req _ file _) lang = do+ let file' = pathString $ lang file+ _ <- liftIO $ getFileInfo req file' -- expecting an error return $ RspSpec movedPermanently301 (BodyFileNoBody hdr) where hdr = redirectHeader req
Network/Wai/Application/Classic/Status.hs view
@@ -13,18 +13,20 @@ import Data.ByteString.Lazy.Char8 () import qualified Data.StaticHash as M import Network.HTTP.Types+import Network.Wai (Request) import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types+import Network.Wai.Handler.Warp ---------------------------------------------------------------- -getStatusInfo :: ClassicAppSpec -> FileAppSpec -> [Lang] -> Status -> IO StatusInfo-getStatusInfo cspec spec langs st = getStatusFile getF dir code langs- ||> getStatusBS code- ||> return StatusNone+getStatusInfo :: ClassicAppSpec -> Request -> [Lang] -> Status -> IO StatusInfo+getStatusInfo cspec req langs st = getStatusFile getF dir code langs+ ||> getStatusBS code+ ||> return StatusNone where dir = statusFileDir cspec- getF = getFileInfo spec+ getF = getFileInfo req code = statusCode st ----------------------------------------------------------------@@ -56,13 +58,15 @@ where toPath s = fromString $ show (statusCode s) ++ ".html" -getStatusFile :: (Path -> IO FileInfo) -> Path -> Int -> [Lang] -> IO StatusInfo+getStatusFile :: (FilePath -> IO FileInfo) -> Path -> Int -> [Lang] -> IO StatusInfo getStatusFile getF dir code langs = tryFile mfiles where mfiles = case M.lookup code statusFileMap of Nothing -> [] Just file -> map ($ (dir </> file)) langs tryFile = foldr func goNext- func f io = StatusFile f . fileInfoSize <$> getF f ||> io+ func f io = StatusFile f . fileInfoSize <$> getF f' ||> io+ where+ f' = pathString f ----------------------------------------------------------------
Network/Wai/Application/Classic/Types.hs view
@@ -8,6 +8,7 @@ import Network.HTTP.Date import Network.HTTP.Types import Network.Wai+import Network.Wai.Handler.Warp (FileInfo(..)) import Network.Wai.Application.Classic.Path ----------------------------------------------------------------@@ -37,17 +38,22 @@ indexFile :: Path -- | Whether this is an HTML or not. , isHTML :: Path -> Bool- -- | A function to obtain information about a file.- -- If information is not obtained, an IO exception should be raised.- , getFileInfo :: Path -> IO FileInfo } -data FileInfo = FileInfo {- fileInfoName :: !Path- , fileInfoSize :: !Integer- , fileInfoTime :: !HTTPDate- , fileInfoDate :: !ByteString+data Fileinfo = Fileinfo {+ fileinfoName :: !Path+ , fileinfoSize :: !Integer+ , fileinfoTime :: !HTTPDate+ , fileinfoDate :: !ByteString } deriving (Eq, Show)++fromFileInfo :: FileInfo -> Fileinfo+fromFileInfo x = Fileinfo {+ fileinfoName = fromString $ fileInfoName x+ , fileinfoSize = fileInfoSize x+ , fileinfoTime = fileInfoTime x+ , fileinfoDate = fileInfoDate x+ } data FileRoute = FileRoute { -- | Path prefix to be matched to 'rawPathInfo'.
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 3.0.8+Version: 3.0.9 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -63,6 +63,7 @@ , unix , wai >= 3.0 && < 3.1 , wai-conduit+ , warp >= 3.1.12 && < 3.2 , word8 Test-Suite doctest@@ -90,9 +91,9 @@ , hspec >= 1.3 , http-types , unix- , wai >= 3+ , wai >= 3.0 && < 3.1 , wai-app-file-cgi- , warp >= 3.0.11+ , warp >= 3.1.12 && < 3.2 , HTTP Source-Repository head