wai-app-file-cgi 3.1.0 → 3.1.1

raw patch · 8 files changed

+49/−106 lines, 8 filesdep ~warpPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: warp

API changes (from Hackage documentation)

Files

• Network/Wai/Application/Classic/CGI.hs +1/−1
• Network/Wai/Application/Classic/File.hs +7/−9
• Network/Wai/Application/Classic/FileInfo.hs +2/−2
• Network/Wai/Application/Classic/Path.hs +32/−70
• Network/Wai/Application/Classic/Redirect.hs +2/−2
• Network/Wai/Application/Classic/RevProxy.hs +2/−2
• Network/Wai/Application/Classic/Types.hs +0/−17
• wai-app-file-cgi.cabal +3/−3

@@ -120,7 +120,7 @@     (prog, scriptName, pathinfo) =         pathinfoToCGI (cgiSrc cgii)                       (cgiDst cgii)-                      (fromByteString (rawPathInfo req))+                      (rawPathInfo req)                       (indexCgi spec)  makeEnv :: Request -> String -> String -> String -> ByteString ->

@@ -8,8 +8,7 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif-import Control.Exception.IOChoice.Lifted-import Control.Monad.IO.Class (liftIO)+import Control.Exception.IOChoice import Data.ByteString (ByteString) import Data.Maybe import qualified Data.ByteString.Char8 as BS (concat)@@ -37,7 +36,7 @@ langSuffixes :: RequestHeaders -> [Lang] langSuffixes hdr = map (\x -> (<.> x)) langs ++ [id, (<.> "en")]   where-    langs = map fromByteString $ languages hdr+    langs = languages hdr  ---------------------------------------------------------------- @@ -80,7 +79,7 @@     rfile = redirectPath spec path     langs = langSuffixes $ requestHeaders req     noBody st = return $ responseLBS st [] ""-    bodyStatus st = liftIO (getStatusInfo cspec req langs st)+    bodyStatus st = getStatusInfo cspec req langs st                 >>= statusBody st     statusBody st StatusNone = noBody st     statusBody st (StatusByteString bd) =@@ -109,10 +108,9 @@ tryGetFile :: HandlerInfo -> Bool -> Lang -> IO RspSpec tryGetFile (HandlerInfo _ req file _) ishtml lang = do     let file' = pathString $ lang file-        hdr = newHeader ishtml $ pathByteString file-    finfo <- fromFileInfo <$> liftIO (getFileInfo req file') -- expecting an error-    let afile = pathString $ fileinfoName finfo-    return $ BodyFile ok200 hdr afile+        hdr = newHeader ishtml file+    _ <- getFileInfo req file' -- expecting an error+    return $ BodyFile ok200 hdr file'  ---------------------------------------------------------------- @@ -126,7 +124,7 @@ tryRedirectFile :: HandlerInfo -> Lang -> IO RspSpec tryRedirectFile (HandlerInfo _ req file _) lang = do     let file' = pathString $ lang file-    _ <- liftIO $ getFileInfo req file' -- expecting an error+    _ <- getFileInfo req file' -- expecting an error     return $ NoBodyHdr movedPermanently301 hdr   where     hdr = redirectHeader req

@@ -9,10 +9,10 @@ pathinfoToFilePath :: Request -> FileRoute -> Path pathinfoToFilePath req filei = path'   where-    path = fromByteString $ rawPathInfo req+    path = rawPathInfo req     src = fileSrc filei     dst = fileDst filei-    path' = dst </> (path <\> src)+    path' = dst </> (path <\> src) -- fixme  addIndex :: FileAppSpec -> Path -> Path addIndex spec path

@@ -1,9 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, BangPatterns #-}  module Network.Wai.Application.Classic.Path (-    Path(..)-  , fromString, fromByteString-  , (+++), (</>), (<\>), (<.>)+    Path+  , pathString+  , fromString+  , (</>), (<\>), (<.>)   , breakAtSeparator, hasLeadingPathSeparator, hasTrailingPathSeparator   , isSuffixOf   ) where@@ -11,38 +12,20 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8-import Data.Function import Data.String import Data.Word  ---------------------------------------------------------------- --- | Smart file path.-data Path = Path {-    pathString :: FilePath-  , pathByteString :: ByteString-  }--instance IsString Path where-    fromString path = Path {-        pathString = path-      , pathByteString = B8.pack path-      }--instance Show Path where-    show = show . pathByteString+-- | File path.+type Path = ByteString -instance Eq Path where-    (==) = (==) `on` pathByteString+pathString :: Path -> String+pathString = B8.unpack+{-# INLINE pathString #-}  ---------------------------------------------------------------- -fromByteString :: ByteString -> Path-fromByteString path = Path {-    pathString = B8.unpack path-  , pathByteString = path-  }- -- pathDot :: Word8 -- pathDot = 46 @@ -64,12 +47,11 @@ False -} hasLeadingPathSeparator :: Path -> Bool-hasLeadingPathSeparator path+hasLeadingPathSeparator bs   | BS.null bs            = False   | BS.head bs == pathSep = True   | otherwise             = False-  where-    bs = pathByteString path+{-# INLINE hasLeadingPathSeparator #-}  {-|   Checking if the path ends with the path separator.@@ -80,23 +62,11 @@ False -} hasTrailingPathSeparator :: Path -> Bool-hasTrailingPathSeparator path+hasTrailingPathSeparator bs   | BS.null bs            = False   | BS.last bs == pathSep = True   | otherwise             = False-  where-    bs = pathByteString path--infixr +++--{-|-  Appending.--}--(+++) :: Path -> Path -> Path-p1 +++ p2 = fromByteString p-  where-    p = pathByteString p1 `BS.append` pathByteString p2+{-# INLINE hasTrailingPathSeparator #-}  {-|   Appending with the file separator.@@ -112,17 +82,15 @@ -}  (</>) :: Path -> Path -> Path-p1 </> p2-  | has1 && not has2 || not has1 && has2 = p1 +++ p2-  | has1      = fromByteString pp1-  | otherwise = fromByteString pp2+p1 </> p2 = p   where-    has1 = hasTrailingPathSeparator p1-    has2 = hasLeadingPathSeparator p2-    p1' = pathByteString p1-    p2' = pathByteString p2-    pp1 = p1' `BS.append` BS.tail p2'-    pp2 = BS.concat [p1',pathSepBS,p2']+    !has1 = hasTrailingPathSeparator p1+    !has2 = hasLeadingPathSeparator p2+    !p | has1 && not has2 = p1 `BS.append` p2+       | not has1 && has2 = p1 `BS.append` p2+       | has1             = p1 `BS.append` BS.tail p2+       | otherwise        = BS.concat [p1,pathSepBS,p2]+{-# INLINE (</>) #-}  {-|   Removing prefix. The prefix of the second argument is removed@@ -136,21 +104,19 @@ "bar" -} (<\>) :: Path -> Path -> Path-p1 <\> p2 = fromByteString p+p1 <\> p2 = p   where-    p1' = pathByteString p1-    p2' = pathByteString p2-    p = BS.drop (BS.length p2') p1'+    !p = BS.drop (BS.length p2) p1+{-# INLINE (<\>) #-}  {-|   Adding suffix. -} (<.>) :: Path -> Path -> Path-p1 <.> p2 = fromByteString p+p1 <.> p2 = p   where-    p1' = pathByteString p1-    p2' = pathByteString p2-    p = BS.concat [p1',pathDotBS,p2']+    !p = BS.concat [p1,pathDotBS,p2]+{-# INLINE (<.>) #-}  {-|   Breaking at the first path separator.@@ -163,13 +129,9 @@ ("foo","") -} breakAtSeparator :: Path -> (Path,Path)-breakAtSeparator p = (fromByteString r1, fromByteString r2)-  where-    p' = pathByteString p-    (r1,r2) = BS.break (== pathSep) p'+breakAtSeparator p = BS.break (== pathSep) p+{-# INLINE breakAtSeparator #-}  isSuffixOf :: Path -> Path -> Bool-isSuffixOf p1 p2 = p1' `BS.isSuffixOf` p2'-  where-    p1' = pathByteString p1-    p2' = pathByteString p2+isSuffixOf = BS.isSuffixOf+{-# INLINE isSuffixOf #-}

@@ -15,11 +15,11 @@ redirectApp _ route req respond =     respond $ responseLBS status hdr ""   where-    path = fromByteString $ rawPathInfo req+    path = rawPathInfo req     src = redirectSrc route     dst = redirectDst route     -- Scheme must not be included because of no way to tell     -- http or https.-    rurl = "//" `append` pathByteString (dst </> (path <\> src))+    rurl = "//" `append` (dst </> (path <\> src))     hdr = locationHeader rurl     status = movedPermanently301

@@ -59,7 +59,7 @@   , H.port           = revProxyPort route   , H.secure         = False -- FIXME: upstream is HTTP only   , H.requestHeaders = addForwardedFor req $ filter headerToBeRelay hdr-  , H.path           = pathByteString path'+  , H.path           = path'   , H.queryString    = dropQuestion query   , H.requestBody    = bodyToHBody len body   , H.method         = requestMethod req@@ -70,7 +70,7 @@   , H.redirectCount  = 0   }   where-    path = fromByteString $ rawPathInfo req+    path = rawPathInfo req     src = revProxySrc route     dst = revProxyDst route     hdr = requestHeaders req

@@ -5,8 +5,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Network.HTTP.Client as H-import Network.HTTP.Date-import Network.Wai.Handler.Warp (FileInfo(..)) import Network.Wai.Application.Classic.Path  ----------------------------------------------------------------@@ -34,21 +32,6 @@     indexFile :: Path     -- | Whether this is an HTML or not.   , isHTML :: Path -> Bool-  }--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 {

@@ -1,5 +1,5 @@ Name:                   wai-app-file-cgi-Version:                3.1.0+Version:                3.1.1 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -62,7 +62,7 @@                       , unix                       , wai >= 3.2 && < 3.3                       , wai-conduit-                      , warp >= 3.2 && < 3.3+                      , warp >= 3.2.6 && < 3.3                       , word8  Test-Suite doctest@@ -92,7 +92,7 @@                       , unix                       , wai >= 3.2 && < 3.3                       , wai-app-file-cgi-                      , warp >= 3.2 && < 3.3+                      , warp >= 3.2.6 && < 3.3                       , HTTP  Source-Repository head