Hello community, here is the log from the commit of package ghc-wai-extra for openSUSE:Factory checked in at 2016-10-22 13:21:18 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-wai-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-wai-extra.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-wai-extra" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-wai-extra/ghc-wai-extra.changes 2016-07-20 09:23:22.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-wai-extra.new/ghc-wai-extra.changes 2016-10-22 13:21:20.000000000 +0200 @@ -1,0 +2,10 @@ +Sat Oct 1 17:18:08 UTC 2016 - [email protected] + +- Update to version 3.0.18 with cabal2obs. + +------------------------------------------------------------------- +Thu Sep 15 06:45:37 UTC 2016 - [email protected] + +- Update to version 3.0.17 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- wai-extra-3.0.16.1.tar.gz New: ---- wai-extra-3.0.18.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-wai-extra.spec ++++++ --- /var/tmp/diff_new_pack.bwQUK5/_old 2016-10-22 13:21:21.000000000 +0200 +++ /var/tmp/diff_new_pack.bwQUK5/_new 2016-10-22 13:21:21.000000000 +0200 @@ -19,15 +19,14 @@ %global pkg_name wai-extra %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.0.16.1 +Version: 3.0.18 Release: 0 Summary: Provides some basic WAI handlers and middleware License: MIT -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-aeson-devel BuildRequires: ghc-ansi-terminal-devel BuildRequires: ghc-base64-bytestring-devel @@ -65,7 +64,6 @@ BuildRequires: ghc-HUnit-devel BuildRequires: ghc-hspec-devel %endif -# End cabal-rpm deps %description Provides basic WAI handler and middleware functionality: @@ -143,20 +141,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ wai-extra-3.0.16.1.tar.gz -> wai-extra-3.0.18.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/ChangeLog.md new/wai-extra-3.0.18/ChangeLog.md --- old/wai-extra-3.0.16.1/ChangeLog.md 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/ChangeLog.md 2016-09-26 06:19:24.000000000 +0200 @@ -1,3 +1,11 @@ +## 3.0.18 + +* ForceSSL: preserve port number when redirecting to https. [#582](https://github.com/yesodweb/wai/pull/582) + +## 3.0.17 + +* Gzip pre compressed [#580](https://github.com/yesodweb/wai/pull/580) + ## 3.0.16.1 * Fix the way the header length is checked (for limiting the max header length) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/Network/Wai/Middleware/ForceSSL.hs new/wai-extra-3.0.18/Network/Wai/Middleware/ForceSSL.hs --- old/wai-extra-3.0.16.1/Network/Wai/Middleware/ForceSSL.hs 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/Network/Wai/Middleware/ForceSSL.hs 2016-09-26 06:19:24.000000000 +0200 @@ -17,7 +17,6 @@ import Data.Monoid ((<>)) import Network.HTTP.Types (hLocation, methodGet, status301, status307) -import qualified Data.ByteString as S import Data.Word8 (_colon) -- | For requests that don't appear secure, redirect to https @@ -31,13 +30,10 @@ redirectResponse :: Request -> Maybe Response redirectResponse req = do - (host, _) <- S.break (== _colon) <$> requestHeaderHost req - - return $ responseBuilder status [(hLocation, location host)] mempty - + host <- requestHeaderHost req + return $ responseBuilder status [(hLocation, location host)] mempty where location h = "https://" <> h <> rawPathInfo req <> rawQueryString req - status | requestMethod req == methodGet = status301 | otherwise = status307 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/Network/Wai/Middleware/Gzip.hs new/wai-extra-3.0.18/Network/Wai/Middleware/Gzip.hs --- old/wai-extra-3.0.16.1/Network/Wai/Middleware/Gzip.hs 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/Network/Wai/Middleware/Gzip.hs 2016-09-26 06:19:24.000000000 +0200 @@ -58,6 +58,10 @@ -- platforms. | GzipCacheFolder FilePath -- ^ Compress files, caching them in -- some directory. + | GzipPreCompressed GzipFiles -- ^ If we use compression then try to use the filename with ".gz" + -- appended to it, if the file is missing then try next action + -- + -- @since 3.0.17 deriving (Show, Eq, Read) -- | Use default MIME settings; /do not/ compress files. @@ -92,13 +96,23 @@ ResponseFile{} | gzipFiles set == GzipIgnore -> sendResponse res _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res) && (bigEnough res) then - case (res, gzipFiles set) of - (ResponseFile s hs file Nothing, GzipCacheFolder cache) -> - case lookup hContentType hs of - Just m - | gzipCheckMime set m -> compressFile s hs file cache sendResponse - _ -> sendResponse res - _ -> compressE set res sendResponse + let runAction x = case x of + (ResponseFile s hs file Nothing, GzipPreCompressed nextAction) -> + let + compressedVersion = file ++ ".gz" + in + doesFileExist compressedVersion >>= \x -> + if x + then (sendResponse $ ResponseFile s (fixHeaders hs) compressedVersion Nothing) + else (runAction (ResponseFile s hs file Nothing, nextAction)) + (ResponseFile s hs file Nothing, GzipCacheFolder cache) -> + case lookup hContentType hs of + Just m + | gzipCheckMime set m -> compressFile s hs file cache sendResponse + _ -> sendResponse res + (ResponseFile {}, GzipIgnore) -> sendResponse res + _ -> compressE set res sendResponse + in runAction (res, gzipFiles set) else sendResponse res where enc = fromMaybe [] $ (splitCommas . S8.unpack) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/Network/Wai/Middleware/Rewrite.hs new/wai-extra-3.0.18/Network/Wai/Middleware/Rewrite.hs --- old/wai-extra-3.0.16.1/Network/Wai/Middleware/Rewrite.hs 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/Network/Wai/Middleware/Rewrite.hs 2016-09-26 06:19:24.000000000 +0200 @@ -1,32 +1,323 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP #-} + module Network.Wai.Middleware.Rewrite - ( rewrite, rewritePure + ( -- * How to use this module + -- $howto + + -- ** A note on semantics + + -- $semantics + + -- ** Paths and Queries + + -- $pathsandqueries + PathsAndQueries + + -- ** An example rewriting paths with queries + + -- $takeover + + -- ** Upgrading from wai-extra ≤ 3.0.16.1 + + -- $upgrading + + -- * 'Middleware' + + -- ** Recommended functions + , rewriteWithQueries + , rewritePureWithQueries + + -- ** Deprecated + , rewrite + , rewritePure + + -- * Operating on 'Request's + + , rewriteRequest + , rewriteRequestPure ) where import Network.Wai import Control.Monad.IO.Class (liftIO) import Data.Text (Text) +import Data.Functor.Identity (Identity(..)) import qualified Data.Text.Encoding as TE import qualified Data.Text as T import Network.HTTP.Types as H +-- GHC ≤ 7.10 does not export Applicative functions from the prelude. +#if __GLASGOW_HASKELL__ <= 710 +import Control.Applicative +#endif --- | rewrite based on your own conversion rules -rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware -rewrite convert app req sendResponse = do - newPathInfo <- liftIO $ convert (pathInfo req) (requestHeaders req) - let rawPInfo = TE.encodeUtf8 $ T.intercalate "/" newPathInfo - app req { pathInfo = newPathInfo, rawPathInfo = rawPInfo } sendResponse +-- $howto +-- This module provides 'Middleware' to rewrite URL paths. It also provides +-- functions that will convert a 'Request' to a modified 'Request'. +-- Both operations require a function that takes URL parameters and +-- headers, and returns new URL parameters. Parameters are pieces of URL +-- paths and query parameters. +-- +-- If you are a new user of the library, use 'rewriteWithQueries' or +-- 'rewritePureWithQueries' for middleware. For modifying 'Request's +-- directly, use 'rewriteRequest' or 'rewriteRequestPure'. + +-- $semantics +-- +-- Versions of this library in wai-extra ≤ 3.0.16.1 exported only +-- 'rewrite' and 'rewritePure' and both modified 'rawPathInfo' of the +-- underlying requests. Such modification has been proscribed. The +-- semantics of these functions have not changed; instead the recommended +-- approach is to use 'rewriteWithQueries' and 'rewritePureWithQueries'. +-- The new functions are slightly different, as described in the section +-- on upgrading; code for previous library versions can be upgraded with +-- a single change, and as the type of the new function is different the +-- compiler will indicate where this change must be made. +-- +-- The 'rewriteRequest' and 'rewriteRequestPure' functions use the new +-- semantics, too. --- | rewrite based on your own conversion rules --- Example convert function: +-- $pathsandqueries +-- +-- This library defines the type synonym `PathsAndQueries` to make code +-- handling paths and queries easier to read. +-- +-- /e.g./ /\/foo\/bar/ would look like +-- +-- > ["foo", "bar"] :: Text +-- +-- /?bar=baz/ would look like +-- +-- > [("bar", Just "baz")] :: QueryText +-- +-- Together, +-- +-- /\/foo?bar=baz/ would look like +-- +-- > (["foo"],[("bar", Just "baz")]) :: PathsAndQueries --- staticConvert :: [Text] -> H.RequestHeaders -> [Text] --- staticConvert pieces _ = piecesConvert pieces +-- $takeover +-- Let’s say we want to replace a website written in PHP with one written +-- using WAI. We’ll use the +-- <https://hackage.haskell.org/package/http-reverse-proxy http-reverse-proxy> +-- package to serve the old +-- site from the new site, but there’s a problem. The old site uses pages like +-- +-- @ +-- index.php?page=/page/ +-- @ +-- +-- whereas the new site would look like +-- +-- @ +-- index\//page/ +-- @ +-- +-- In doing this, we want to separate the migration code from our new +-- website. So we’d like to handle links internally using the path +-- formulation, but externally have the old links still work. +-- +-- Therefore, we will use middleware ('rewritePureWithQueries') from this +-- module to rewrite incoming requests from the query formulation to the +-- paths formulation. +-- +-- > {-# LANGUAGE ViewPatterns #-} +-- > +-- > rewritePathFromPhp :: Middleware +-- > rewritePathFromPhp = rewritePureWithQueries pathFromPhp +-- > +-- > pathFromPhp :: PathsAndQueries -> H.RequestHeaders -> PathsAndQueries +-- > pathFromPhp (pieces, queries) _ = piecesConvert pieces queries +-- > where +-- > piecesConvert :: [Text] -> H.Query -> PathsAndQueries +-- > piecesConvert ["index.php"] qs@(join . lookup "page" -> Just page) = +-- > ( ["index", TE.decodeUtf8With TE.lenientDecode page] +-- > , delete ("page", pure page) qs +-- > ) +-- > piecesConvert ps qs = (ps, qs) +-- +-- On the other side, we will use 'rewriteRequestPure' to rewrite outgoing +-- requests to the original website from the reverse proxy code (using the +-- 'Network.HTTP.ReverseProxy.WPRModifiedRequest' or +-- 'Network.HTTP.ReverseProxy.WPRModifiedRequestSecure' constructors. Note, +-- these links will only work if the haddock documentation for +-- <https://hackage.haskell.org/package/http-reverse-proxy http-reverse-proxy> +-- is installed). +-- +-- > rewritePhpFromPath :: Request -> Request +-- > rewritePhpFromPath = rewriteRequestPure phpFromPath +-- > +-- > phpFromPath :: PathsAndQueries -> H.RequestHeaders -> PathsAndQueries +-- > phpFromPath (pieces, queries) _ = piecesConvert pieces queries +-- > where +-- > piecesConvert :: [Text] -> H.Query -> PathsAndQueries +-- > piecesConvert ["index", page] qs = ( ["index.php"], ("page", pure . TE.encodeUtf8 $ page) : qs ) +-- > piecesConvert ps qs = (ps, qs) +-- +-- For the whole example, see +-- <https://gist.github.com/dbaynard/c844d0df124f68ec8b6da152c581ce6d>. + +-- $upgrading +-- It is quite simple to upgrade from 'rewrite' and 'rewritePure', to +-- 'rewriteWithQueries' and 'rewritePureWithQueries'. +-- Insert 'Data.Bifunctor.first', which specialises to +-- +-- @ +-- 'Data.Bifunctor.first' :: (['Text'] -> ['Text']) -> 'PathsAndQueries' -> 'PathsAndQueries' +-- @ +-- +-- as the following example demonstrates. +-- +-- Old versions of the libary could only handle path pieces, not queries. +-- This could have been supplied to 'rewritePure'. +-- +-- @ +-- staticConvert' :: [Text] -> H.RequestHeaders -> [Text] +-- staticConvert' pieces _ = piecesConvert pieces -- where -- piecesConvert [] = ["static", "html", "pages.html"] -- piecesConvert route@("pages":_) = "static":"html":route +-- @ +-- +-- Instead, use this function, supplied to 'rewritePureWithQueries'. +-- +-- @ +-- staticConvert :: 'PathsAndQueries' -> H.RequestHeaders -> 'PathsAndQueries' +-- staticConvert pathsAndQueries _ = 'Data.Bifunctor.first' piecesConvert pathsAndQueries +-- where +-- piecesConvert [] = ["static", "html", "pages.html"] +-- piecesConvert route@("pages":_) = "static":"html":route +-- @ +-- +-- The former formulation is deprecated for two reasons: +-- +-- 1. The original formulation of 'rewrite' modified 'rawPathInfo', which +-- is deprecated behaviour. +-- +-- 2. The original formulation did not allow query parameters to +-- influence the path. +-- +-- Concerning the first point, take care with semantics of your program when +-- upgrading as the upgraded functions no longer modify 'rawPathInfo'. + +-------------------------------------------------- +-- * Types +-------------------------------------------------- + +-- | A tuple of the path sections as ['Text'] and query parameters as +-- 'H.Query'. This makes writing type signatures for the conversion +-- function far more pleasant. +-- +-- Note that this uses 'H.Query' not 'H.QueryText' to more accurately +-- reflect the paramaters that can be supplied in URLs. It may be safe to +-- treat parameters as text; use the 'H.queryToQueryText' and +-- 'H.queryTextToQuery' functions to interconvert. +type PathsAndQueries = ([Text], H.Query) + +-------------------------------------------------- +-- * Rewriting 'Middleware' +-------------------------------------------------- + +-- | Rewrite based on your own conversion function for paths only, to be +-- supplied by users of this library (with the conversion operating in 'IO'). +-- +-- For new code, use 'rewriteWithQueries' instead. +rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware +rewrite convert app req sendResponse = do + let convertIO = pathsOnly . curry $ liftIO . uncurry convert + newReq <- rewriteRequestRawM convertIO req + app newReq sendResponse +{-# WARNING rewrite [ + "This modifies the 'rawPathInfo' field of a 'Request'." + , " This is not recommended behaviour; it is however how" + , " this function has worked in the past." + , " Use 'rewriteWithQueries' instead"] #-} + +-- | Rewrite based on pure conversion function for paths only, to be +-- supplied by users of this library. +-- +-- For new code, use 'rewritePureWithQueries' instead. rewritePure :: ([Text] -> H.RequestHeaders -> [Text]) -> Middleware rewritePure convert app req = - let pInfo = convert (pathInfo req) (requestHeaders req) - rawPInfo = TE.encodeUtf8 $ T.intercalate "/" pInfo - in app req { pathInfo = pInfo, rawPathInfo = rawPInfo } + let convertPure = pathsOnly . curry $ Identity . uncurry convert + newReq = runIdentity $ rewriteRequestRawM convertPure req + in app newReq +{-# WARNING rewritePure [ + "This modifies the 'rawPathInfo' field of a 'Request'." + , " This is not recommended behaviour; it is however how" + , " this function has worked in the past." + , " Use 'rewritePureWithQueries' instead"] #-} + +-- | Rewrite based on your own conversion function for paths and queries. +-- This function is to be supplied by users of this library, and operates +-- in 'IO'. +rewriteWithQueries :: (PathsAndQueries -> H.RequestHeaders -> IO PathsAndQueries) + -> Middleware +rewriteWithQueries convert app req sendResponse = do + newReq <- rewriteRequestM convert req + app newReq sendResponse + +-- | Rewrite based on pure conversion function for paths and queries. This +-- function is to be supplied by users of this library. +rewritePureWithQueries :: (PathsAndQueries -> H.RequestHeaders -> PathsAndQueries) + -> Middleware +rewritePureWithQueries convert app req = app $ rewriteRequestPure convert req + +-------------------------------------------------- +-- * Modifying 'Request's directly +-------------------------------------------------- + +-- | Modify a 'Request' using the supplied function in 'IO'. This is suitable for +-- the reverse proxy example. +rewriteRequest :: (PathsAndQueries -> H.RequestHeaders -> IO PathsAndQueries) + -> Request -> IO Request +rewriteRequest convert req = + let convertIO = curry $ liftIO . uncurry convert + in rewriteRequestRawM convertIO req + +-- | Modify a 'Request' using the pure supplied function. This is suitable for +-- the reverse proxy example. +rewriteRequestPure :: (PathsAndQueries -> H.RequestHeaders -> PathsAndQueries) + -> Request -> Request +rewriteRequestPure convert req = + let convertPure = curry $ Identity . uncurry convert + in runIdentity $ rewriteRequestRawM convertPure req + +-------------------------------------------------- +-- * Helper functions +-------------------------------------------------- + +-- | This helper function factors out the common behaviour of rewriting requests. +rewriteRequestM :: (Applicative m, Monad m) + => (PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries) + -> Request -> m Request +rewriteRequestM convert req = do + (pInfo, qByteStrings) <- curry convert (pathInfo req) (queryString req) (requestHeaders req) + pure req {pathInfo = pInfo, queryString = qByteStrings} + +-- | This helper function preserves the semantics of wai-extra ≤ 3.0, in +-- which the rewrite functions modify the 'rawPathInfo' parameter. Note +-- that this has not been extended to modify the 'rawQueryInfo' as +-- modifying either of these values has been deprecated. +rewriteRequestRawM :: (Applicative m, Monad m) + => (PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries) + -> Request -> m Request +rewriteRequestRawM convert req = do + newReq <- rewriteRequestM convert req + let rawPInfo = TE.encodeUtf8 . T.intercalate "/" . pathInfo $ newReq + pure newReq { rawPathInfo = rawPInfo } +{-# WARNING rewriteRequestRawM [ + "This modifies the 'rawPathInfo' field of a 'Request'." + , " This is not recommended behaviour; it is however how" + , " this function has worked in the past." + , " Use 'rewriteRequestM' instead"] #-} + +-- | Produce a function that works on 'PathsAndQueries' from one working +-- only on paths. This is not exported, as it is only needed to handle +-- code written for versions ≤ 3.0 of the library; see the +-- example above using 'Data.Bifunctor.first' to do something similar. +pathsOnly :: (Applicative m, Monad m) + => ([Text] -> H.RequestHeaders -> m [Text]) + -> PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries +pathsOnly convert psAndQs headers = (,[]) <$> convert (fst psAndQs) headers +{-# INLINE pathsOnly #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/test/Network/Wai/Middleware/ForceSSLSpec.hs new/wai-extra-3.0.18/test/Network/Wai/Middleware/ForceSSLSpec.hs --- old/wai-extra-3.0.16.1/test/Network/Wai/Middleware/ForceSSLSpec.hs 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/test/Network/Wai/Middleware/ForceSSLSpec.hs 2016-09-26 06:19:24.000000000 +0200 @@ -8,6 +8,7 @@ import Network.Wai.Middleware.ForceSSL +import Control.Monad import Data.ByteString (ByteString) import Data.Monoid ((<>)) import Network.HTTP.Types (methodPost, status200, status301, status307) @@ -18,8 +19,12 @@ main = hspec spec spec :: Spec -spec = describe "forceSSL" $ do - let host = "example.com" +spec = describe "forceSSL" (forM_ hosts $ \host -> hostSpec host) + where + hosts = ["example.com", "example.com:80", "example.com:8080"] + +hostSpec :: ByteString -> Spec +hostSpec host = describe ("forceSSL on host " <> show host <> "") $ do it "redirects non-https requests to https" $ do resp <- runApp host forceSSL defaultRequest @@ -39,7 +44,7 @@ simpleStatus resp `shouldBe` status200 - it "preserves the original path and query string" $ do + it "preserves the original host, path, and query string" $ do resp <- runApp host forceSSL defaultRequest { rawPathInfo = "/foo/bar" , rawQueryString = "?baz=bat" @@ -50,7 +55,6 @@ runApp :: ByteString -> Middleware -> Request -> IO SResponse runApp host mw req = runSession - (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app - + (request req { requestHeaderHost = Just host }) $ mw app where app _ respond = respond $ responseLBS status200 [] "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.16.1/wai-extra.cabal new/wai-extra-3.0.18/wai-extra.cabal --- old/wai-extra-3.0.16.1/wai-extra.cabal 2016-07-06 11:53:58.000000000 +0200 +++ new/wai-extra-3.0.18/wai-extra.cabal 2016-09-26 06:19:24.000000000 +0200 @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.0.16.1 +Version: 3.0.18 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality:
