Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-wai-extra for openSUSE:Factory checked in at 2023-01-18 13:10:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-wai-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-wai-extra.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-wai-extra" Wed Jan 18 13:10:56 2023 rev:12 rq:1059126 version:3.1.13.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-wai-extra/ghc-wai-extra.changes 2022-08-10 17:14:40.749923980 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-wai-extra.new.32243/ghc-wai-extra.changes 2023-01-18 13:11:23.268982963 +0100 @@ -1,0 +2,8 @@ +Tue Nov 1 23:47:27 UTC 2022 - Peter Simons <[email protected]> + +- Update wai-extra to version 3.1.13.0 revision 1. + ## 3.1.13.0 + + * Added `Combine Headers` `Middleware` [#901](https://github.com/yesodweb/wai/pull/901) + +------------------------------------------------------------------- Old: ---- wai-extra-3.1.12.1.tar.gz New: ---- wai-extra-3.1.13.0.tar.gz wai-extra.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-wai-extra.spec ++++++ --- /var/tmp/diff_new_pack.nSahaa/_old 2023-01-18 13:11:23.984985738 +0100 +++ /var/tmp/diff_new_pack.nSahaa/_new 2023-01-18 13:11:23.988985753 +0100 @@ -19,12 +19,13 @@ %global pkg_name wai-extra %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.1.12.1 +Version: 3.1.13.0 Release: 0 Summary: Provides some basic WAI handlers and middleware License: MIT URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-HUnit-devel BuildRequires: ghc-aeson-devel @@ -39,7 +40,6 @@ BuildRequires: ghc-directory-devel BuildRequires: ghc-fast-logger-devel BuildRequires: ghc-http-types-devel -BuildRequires: ghc-http2-devel BuildRequires: ghc-iproute-devel BuildRequires: ghc-network-devel BuildRequires: ghc-resourcet-devel @@ -52,6 +52,7 @@ BuildRequires: ghc-vault-devel BuildRequires: ghc-wai-devel BuildRequires: ghc-wai-logger-devel +BuildRequires: ghc-warp-devel BuildRequires: ghc-word8-devel ExcludeArch: %{ix86} %if %{with tests} @@ -85,6 +86,10 @@ Clean a request path to a canonical form. +* Combine Headers + +Combine duplicate headers into one. + * GZip Compression Negotiate HTTP payload gzip compression. @@ -142,6 +147,7 @@ %prep %autosetup -n %{pkg_name}-%{version} +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ wai-extra-3.1.12.1.tar.gz -> wai-extra-3.1.13.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/ChangeLog.md new/wai-extra-3.1.13.0/ChangeLog.md --- old/wai-extra-3.1.12.1/ChangeLog.md 2022-05-14 20:06:22.000000000 +0200 +++ new/wai-extra-3.1.13.0/ChangeLog.md 2022-11-01 07:19:06.000000000 +0100 @@ -1,5 +1,9 @@ # Changelog for wai-extra +## 3.1.13.0 + +* Added `Combine Headers` `Middleware` [#901](https://github.com/yesodweb/wai/pull/901) + ## 3.1.12.1 * Include test/{json.gz,noprecompress} as extra-source-files [#887](https://github.com/yesodweb/wai/pull/887) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Header.hs new/wai-extra-3.1.13.0/Network/Wai/Header.hs --- old/wai-extra-3.1.12.1/Network/Wai/Header.hs 2022-05-09 12:52:16.000000000 +0200 +++ new/wai-extra-3.1.13.0/Network/Wai/Header.hs 2022-11-01 07:19:06.000000000 +0100 @@ -1,21 +1,20 @@ -{-# LANGUAGE CPP #-} -- | Some helpers for dealing with WAI 'Header's. module Network.Wai.Header ( contentLength , parseQValueList , replaceHeader - , splitCommas - , trimWS ) where import Control.Monad (guard) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Data.ByteString.Internal (w2c) -import Data.Word8 (Word8, _0, _1, _comma, _period, _semicolon, _space) +import Data.Word8 (_0, _1, _period, _semicolon, _space) import Network.HTTP.Types as H import Text.Read (readMaybe) +import Network.Wai.Util (dropWhileEnd, splitCommas) + -- | More useful for a response. A Wai Request already has a requestBodyLength contentLength :: [(HeaderName, S8.ByteString)] -> Maybe Integer contentLength hdrs = lookup H.hContentLength hdrs >>= readInt @@ -31,22 +30,6 @@ replaceHeader name val old = (name, val) : filter ((/= name) . fst) old --- | Used to split a header value which is a comma separated list -splitCommas :: S.ByteString -> [S.ByteString] -splitCommas = map trimWS . S.split _comma - --- Trim whitespace -trimWS :: S.ByteString -> S.ByteString -trimWS = dropWhileEnd (== _space) . S.dropWhile (== _space) - --- | Dropping all 'Word8's from the end that satisfy the predicate. -dropWhileEnd :: (Word8 -> Bool) -> S.ByteString -> S.ByteString -#if MIN_VERSION_bytestring(0,10,12) -dropWhileEnd = S.dropWhileEnd -#else -dropWhileEnd p = fst . S.spanEnd p -#endif - -- | Only to be used on header's values which support quality value syntax -- -- A few things to keep in mind when using this function: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Middleware/CombineHeaders.hs new/wai-extra-3.1.13.0/Network/Wai/Middleware/CombineHeaders.hs --- old/wai-extra-3.1.12.1/Network/Wai/Middleware/CombineHeaders.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/wai-extra-3.1.13.0/Network/Wai/Middleware/CombineHeaders.hs 2022-11-01 07:19:06.000000000 +0100 @@ -0,0 +1,299 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{- | +Sometimes incoming requests don't stick to the +"no duplicate headers" invariant, for a number +of possible reasons (e.g. proxy servers blindly +adding headers), or your application (or other +middleware) blindly adds headers. + +In those cases, you can use this 'Middleware' +to make sure that headers that /can/ be combined +/are/ combined. (e.g. applications might only +check the first \"Accept\" header and fail, while +there might be another one that would match) + -} +module Network.Wai.Middleware.CombineHeaders + ( combineHeaders + , CombineSettings + , defaultCombineSettings + , HeaderMap + , HandleType + , defaultHeaderMap + -- * Adjusting the settings + , setHeader + , removeHeader + , setHeaderMap + , regular + , keepOnly + , setRequestHeaders + , setResponseHeaders + ) where + +import qualified Data.ByteString as B +import qualified Data.List as L (foldl', reverse) +import qualified Data.Map.Strict as M +import Data.Word8 (_comma, _space, _tab) +import Network.HTTP.Types (Header, HeaderName, RequestHeaders) +import qualified Network.HTTP.Types.Header as H +import Network.Wai (Middleware, requestHeaders, mapResponseHeaders) +import Network.Wai.Util (dropWhileEnd) + +-- | The mapping of 'HeaderName' to 'HandleType' +type HeaderMap = M.Map HeaderName HandleType + +-- | These settings define which headers should be combined, +-- if the combining should happen on incoming (request) headers +-- and if it should happen on outgoing (response) headers. +-- +-- Any header you put in the header map *will* be used to +-- combine those headers with commas. There's no check to see +-- if it is a header that allows comma-separated lists, so if +-- you want to combine custom headers, go ahead. +-- +-- (You can check the documentation of 'defaultCombineSettings' +-- to see which standard headers are specified to be able to be +-- combined) +-- +-- @since 3.1.13.0 +data CombineSettings = CombineSettings { + combineHeaderMap :: HeaderMap, + -- ^ Which headers should be combined? And how? (cf. 'HandleType') + combineRequestHeaders :: Bool, + -- ^ Should request headers be combined? + combineResponseHeaders :: Bool + -- ^ Should response headers be combined? +} deriving (Eq, Show) + +-- | Settings that combine request headers, +-- but don't touch response headers. +-- +-- All types of headers that /can/ be combined +-- (as defined in the spec) /will/ be combined. +-- +-- To be exact, this is the list: +-- +-- * Accept +-- * Accept-CH +-- * Accept-Charset +-- * Accept-Encoding +-- * Accept-Language +-- * Accept-Post +-- * Access-Control-Allow-Headers +-- * Access-Control-Allow-Methods +-- * Access-Control-Expose-Headers +-- * Access-Control-Request-Headers +-- * Allow +-- * Alt-Svc @(KeepOnly \"clear\"")@ +-- * Cache-Control +-- * Clear-Site-Data @(KeepOnly \"*\")@ +-- * Connection +-- * Content-Encoding +-- * Content-Language +-- * Digest +-- * If-Match +-- * If-None-Match @(KeepOnly \"*\")@ +-- * Link +-- * Permissions-Policy +-- * TE +-- * Timing-Allow-Origin @(KeepOnly \"*\")@ +-- * Trailer +-- * Transfer-Encoding +-- * Upgrade +-- * Via +-- * Vary @(KeepOnly \"*\")@ +-- * Want-Digest +-- +-- N.B. Any header name that has \"KeepOnly\" after it +-- will be combined like normal, unless one of the values +-- is the one mentioned (\"*\" most of the time), then +-- that value is used and all others are dropped. +-- +-- @since 3.1.13.0 +defaultCombineSettings :: CombineSettings +defaultCombineSettings = CombineSettings { + combineHeaderMap = defaultHeaderMap, + combineRequestHeaders = True, + combineResponseHeaders = False +} + +-- | Override the 'HeaderMap' of the 'CombineSettings' +-- (default: 'defaultHeaderMap') +-- +-- @since 3.1.13.0 +setHeaderMap :: HeaderMap -> CombineSettings -> CombineSettings +setHeaderMap mp set = set{combineHeaderMap = mp} + +-- | Set whether the combining of headers should be applied to +-- the incoming request headers. (default: True) +-- +-- @since 3.1.13.0 +setRequestHeaders :: Bool -> CombineSettings -> CombineSettings +setRequestHeaders b set = set{combineRequestHeaders = b} + +-- | Set whether the combining of headers should be applied to +-- the outgoing response headers. (default: False) +-- +-- @since 3.1.13.0 +setResponseHeaders :: Bool -> CombineSettings -> CombineSettings +setResponseHeaders b set = set{combineResponseHeaders = b} + +-- | Convenience function to add a header to the header map or, +-- if it is already in the map, to change the 'HandleType'. +-- +-- @since 3.1.13.0 +setHeader :: HeaderName -> HandleType -> CombineSettings -> CombineSettings +setHeader name typ settings = + settings { + combineHeaderMap = M.insert name typ $ combineHeaderMap settings + } + +-- | Convenience function to remove a header from the header map. +-- +-- @since 3.1.13.0 +removeHeader :: HeaderName -> CombineSettings -> CombineSettings +removeHeader name settings = + settings { + combineHeaderMap = M.delete name $ combineHeaderMap settings + } + +-- | This middleware will reorganize the incoming and/or outgoing +-- headers in such a way that it combines any duplicates of +-- headers that, on their own, can normally have more than one +-- value, and any other headers will stay untouched. +-- +-- This middleware WILL change the global order of headers +-- (they will be put in alphabetical order), but keep the +-- order of the same type of header. I.e. if there are 3 +-- \"Set-Cookie\" headers, the first one will still be first, +-- the second one will still be second, etc. But now they are +-- guaranteed to be next to each other. +-- +-- N.B. This 'Middleware' assumes the headers it combines +-- are correctly formatted. If one of the to-be-combined +-- headers is malformed, the new combined header will also +-- (probably) be malformed. +-- +-- @since 3.1.13.0 +combineHeaders :: CombineSettings -> Middleware +combineHeaders CombineSettings{..} app req resFunc = + app newReq $ resFunc . adjustRes + where + newReq + | combineRequestHeaders = req { requestHeaders = mkNewHeaders oldHeaders } + | otherwise = req + oldHeaders = requestHeaders req + adjustRes + | combineResponseHeaders = mapResponseHeaders mkNewHeaders + | otherwise = id + mkNewHeaders = + M.foldrWithKey' finishHeaders [] . L.foldl' go mempty + go acc hdr@(name, _) = + M.alter (checkHeader hdr) name acc + checkHeader :: Header -> Maybe HeaderHandling -> Maybe HeaderHandling + checkHeader (name, newVal) = Just . \case + Nothing -> (name `M.lookup` combineHeaderMap, [newVal]) + -- Yes, this reverses the order of headers, but these + -- will be reversed again in 'finishHeaders' + Just (mHandleType, hdrs) -> (mHandleType, newVal : hdrs) + +-- | Unpack 'HeaderHandling' back into 'Header's again +finishHeaders :: HeaderName -> HeaderHandling -> RequestHeaders -> RequestHeaders +finishHeaders name (shouldCombine, xs) hdrs = + case shouldCombine of + Just typ -> (name, combinedHeader typ) : hdrs + Nothing -> + -- Yes, this reverses the headers, but they + -- were already reversed by 'checkHeader' + L.foldl' (\acc el -> (name, el) : acc) hdrs xs + where + combinedHeader Regular = combineHdrs xs + combinedHeader (KeepOnly val) + | val `elem` xs = val + | otherwise = combineHdrs xs + -- headers were reversed, so do 'reverse' before combining + combineHdrs = B.intercalate ", " . fmap clean . L.reverse + clean = dropWhileEnd $ \w -> w == _comma || w == _space || w == _tab + +type HeaderHandling = (Maybe HandleType, [B.ByteString]) + +-- | Both will concatenate with @,@ (commas), but 'KeepOnly' will drop all +-- values except the given one if present (e.g. in case of wildcards/special values) +-- +-- For example: If there are multiple @"Clear-Site-Data"@ headers, but one of +-- them is the wildcard @\"*\"@ value, using @'KeepOnly' "*"@ will cause all +-- others to be dropped and only the wildcard value to remain. +-- (The @\"*\"@ wildcard in this case means /ALL site data/ should be cleared, +-- so no need to include more) +-- +-- @since 3.1.13.0 +data HandleType + = Regular + | KeepOnly B.ByteString + deriving (Eq, Show) + +-- | Use the regular strategy when combining headers. +-- (i.e. merge into one header and separate values with commas) +-- +-- @since 3.1.13.0 +regular :: HandleType +regular = Regular + +-- | Use the regular strategy when combining headers, +-- but if the exact supplied 'ByteString' is encountered +-- then discard all other values and only keep that value. +-- +-- e.g. @keepOnly "*"@ will drop all other encountered values +-- +-- @since 3.1.13.0 +keepOnly :: B.ByteString -> HandleType +keepOnly = KeepOnly + +-- | The default collection of HTTP headers that can be combined +-- in case there are multiples in one request or response. +-- +-- See the documentation of 'defaultCombineSettings' for the exact list. +-- +-- @since 3.1.13.0 +defaultHeaderMap :: HeaderMap +defaultHeaderMap = M.fromList + [ (H.hAccept, Regular) + , ("Accept-CH", Regular) + , (H.hAcceptCharset, Regular) + , (H.hAcceptEncoding, Regular) + , (H.hAcceptLanguage, Regular) + , ("Accept-Post", Regular) + , ("Access-Control-Allow-Headers" , Regular) -- wildcard? yes, but can just add to list + , ("Access-Control-Allow-Methods" , Regular) -- wildcard? yes, but can just add to list + , ("Access-Control-Expose-Headers" , Regular) -- wildcard? yes, but can just add to list + , ("Access-Control-Request-Headers", Regular) + , (H.hAllow, Regular) + , ("Alt-Svc", KeepOnly "clear") -- special "clear" value (if any is "clear", only keep that one) + , (H.hCacheControl, Regular) + , ("Clear-Site-Data", KeepOnly "*") -- wildcard (if any is "*", only keep that one) + + -- If "close" and anything else is used together, it's already F-ed, + -- so just combine them. + , (H.hConnection, Regular) + + , (H.hContentEncoding, Regular) + , (H.hContentLanguage, Regular) + , ("Digest", Regular) + + -- We could handle this, but it's experimental AND + -- will be replaced by "Permissions-Policy" + -- , "Feature-Policy" -- "semicolon ';' separated" + + , (H.hIfMatch, Regular) + , (H.hIfNoneMatch, KeepOnly "*") -- wildcard? (if any is "*", only keep that one) + , ("Link", Regular) + , ("Permissions-Policy", Regular) + , (H.hTE, Regular) + , ("Timing-Allow-Origin", KeepOnly "*") -- wildcard? (if any is "*", only keep that one) + , (H.hTrailer, Regular) + , (H.hTransferEncoding, Regular) + , (H.hUpgrade, Regular) + , (H.hVia, Regular) + , (H.hVary, KeepOnly "*") -- wildcard? (if any is "*", only keep that one) + , ("Want-Digest", Regular) + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Middleware/Gzip.hs new/wai-extra-3.1.13.0/Network/Wai/Middleware/Gzip.hs --- old/wai-extra-3.1.12.1/Network/Wai/Middleware/Gzip.hs 2022-05-09 12:52:16.000000000 +0200 +++ new/wai-extra-3.1.13.0/Network/Wai/Middleware/Gzip.hs 2022-11-01 07:19:06.000000000 +0100 @@ -63,7 +63,8 @@ import System.Directory (createDirectoryIfMissing, doesFileExist) import qualified System.IO as IO -import Network.Wai.Header (contentLength, parseQValueList, replaceHeader, splitCommas, trimWS) +import Network.Wai.Header (contentLength, parseQValueList, replaceHeader) +import Network.Wai.Util (splitCommas, trimWS) -- $howto -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Middleware/RequestLogger.hs new/wai-extra-3.1.13.0/Network/Wai/Middleware/RequestLogger.hs --- old/wai-extra-3.1.12.1/Network/Wai/Middleware/RequestLogger.hs 2022-04-18 09:12:07.000000000 +0200 +++ new/wai-extra-3.1.13.0/Network/Wai/Middleware/RequestLogger.hs 2022-10-24 10:38:02.000000000 +0200 @@ -1,7 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -- NOTE: Due to https://github.com/yesodweb/wai/issues/192, this module should -- not use CPP. +-- EDIT: Fixed this by adding two "zero-width spaces" in between the "*/*" module Network.Wai.Middleware.RequestLogger ( -- * Basic stdout logging logStdout @@ -38,7 +40,9 @@ import Data.Default.Class (Default (def)) import Data.IORef import Data.Maybe (fromMaybe, isJust, mapMaybe) -import Data.Monoid (mconcat, (<>)) +#if __GLASGOW_HASKELL__ < 804 +import Data.Monoid ((<>)) +#endif import Data.Text.Encoding (decodeUtf8') import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime) import Network.HTTP.Types as H @@ -321,15 +325,17 @@ -- Example ouput: -- -- > GET search --- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 +-- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*â/â*;q=0.8 -- > Status: 200 OK 0.010555s -- > -- > GET static/css/normalize.css -- > Params: [("LXwioiBG","")] --- > Accept: text/css,*/*;q=0.1 +-- > Accept: text/css,*â/â*;q=0.1 -- > Status: 304 Not Modified 0.010555s - detailedMiddleware :: Callback -> DetailedSettings -> IO Middleware + +-- NB: The *â/â* in the comments above have "zero-width spaces" in them, so the +-- CPP doesn't screw up everything. So don't copy those; they're technically wrong. detailedMiddleware cb settings = let (ansiColor, ansiMethod, ansiStatusCode) = if useColors settings diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Parse.hs new/wai-extra-3.1.13.0/Network/Wai/Parse.hs --- old/wai-extra-3.1.12.1/Network/Wai/Parse.hs 2022-04-18 09:12:07.000000000 +0200 +++ new/wai-extra-3.1.13.0/Network/Wai/Parse.hs 2022-09-11 14:48:49.000000000 +0200 @@ -70,14 +70,10 @@ import Network.HTTP.Types (hContentType) import qualified Network.HTTP.Types as H import Network.Wai +import Network.Wai.Handler.Warp (InvalidRequest(..)) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (hClose, openBinaryTempFile) import System.IO.Error (isDoesNotExistError) -#if MIN_VERSION_http2(3,0,0) -import Network.HTTP2.Frame (ErrorCodeId (..), HTTP2Error (..)) -#else -import Network.HTTP2 (ErrorCodeId (..), HTTP2Error (..)) -#endif breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s = @@ -444,8 +440,7 @@ bs <- readSource src case maxlen of Just maxlen' -> when (S.length front > maxlen') $ - E.throwIO $ ConnectionError (UnknownErrorCode 431) - "Request Header Fields Too Large" + E.throwIO RequestHeaderFieldsTooLarge Nothing -> return () if S.null bs then close front @@ -461,8 +456,7 @@ let res = front `S.append` x case maxlen of Just maxlen' -> when (S.length res > maxlen') $ - E.throwIO $ ConnectionError (UnknownErrorCode 431) - "Request Header Fields Too Large" + E.throwIO RequestHeaderFieldsTooLarge Nothing -> return () return . Just $ killCR res @@ -651,8 +645,7 @@ cur <- atomicModifyIORef' sref $ \ cur -> let new = cur + fromIntegral (S.length bs) in (new, new) case max' of - Just max'' | cur > max'' -> - E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large" + Just max'' | cur > max'' -> E.throwIO PayloadTooLarge _ -> return () if S.null bs then do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/Network/Wai/Util.hs new/wai-extra-3.1.13.0/Network/Wai/Util.hs --- old/wai-extra-3.1.12.1/Network/Wai/Util.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/wai-extra-3.1.13.0/Network/Wai/Util.hs 2022-11-01 07:19:06.000000000 +0100 @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +-- | Some helpers functions. +module Network.Wai.Util + ( dropWhileEnd + , splitCommas + , trimWS + ) where + +import qualified Data.ByteString as S +import Data.Word8 (Word8, _comma, _space) + +-- | Used to split a header value which is a comma separated list +splitCommas :: S.ByteString -> [S.ByteString] +splitCommas = map trimWS . S.split _comma + +-- Trim whitespace +trimWS :: S.ByteString -> S.ByteString +trimWS = dropWhileEnd (== _space) . S.dropWhile (== _space) + +-- | Dropping all 'Word8's from the end that satisfy the predicate. +dropWhileEnd :: (Word8 -> Bool) -> S.ByteString -> S.ByteString +#if MIN_VERSION_bytestring(0,10,12) +dropWhileEnd = S.dropWhileEnd +#else +dropWhileEnd p = fst . S.spanEnd p +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/test/Network/Wai/Middleware/CombineHeadersSpec.hs new/wai-extra-3.1.13.0/test/Network/Wai/Middleware/CombineHeadersSpec.hs --- old/wai-extra-3.1.12.1/test/Network/Wai/Middleware/CombineHeadersSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/wai-extra-3.1.13.0/test/Network/Wai/Middleware/CombineHeadersSpec.hs 2022-11-01 07:19:06.000000000 +0100 @@ -0,0 +1,134 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.Wai.Middleware.CombineHeadersSpec + ( main + , spec + ) where + +import Data.ByteString (ByteString) +import Data.IORef (newIORef, readIORef, writeIORef) +import Network.HTTP.Types (status200) +import Network.HTTP.Types.Header +import Network.Wai +import Test.Hspec + +import Network.Wai.Middleware.CombineHeaders (CombineSettings, combineHeaders, defaultCombineSettings, setRequestHeaders, setResponseHeaders) +import Network.Wai.Test (SResponse (simpleHeaders), request, runSession) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + let test name settings reqHeaders expectedReqHeaders resHeaders expectedResHeaders = it name $ do + (reqHdrs, resHdrs) <- runApp settings reqHeaders resHeaders + reqHdrs `shouldBe` expectedReqHeaders + resHdrs `shouldBe` expectedResHeaders + testReqHdrs name a b = + test name defaultCombineSettings a b [] [] + testResHdrs name a b = + test name (setRequestHeaders False $ setResponseHeaders True defaultCombineSettings) [] [] a b + + -- Request Headers + testReqHdrs + "should reorder alphabetically (request)" + [host , userAgent, acceptHtml] + [acceptHtml, host , userAgent ] + -- Response Headers + testResHdrs + "should reorder alphabetically (response)" + [expires , location, contentTypeHtml] + [contentTypeHtml, expires , location ] + + -- Request Headers + testReqHdrs + "combines Accept (in order)" + [userAgent, acceptHtml, host, acceptJSON] + [acceptHtml `combineHdrs` acceptJSON, host, userAgent] + -- Response Headers + testResHdrs + -- Using the default header map, Cache-Control is a "combineable" header, "Set-Cookie" is not + "combines Cache-Control (in order) and keeps Set-Cookie (in order)" + [ cacheControlPublic, setCookie "2", date, cacheControlMax, setCookie "1"] + [ cacheControlPublic `combineHdrs` cacheControlMax, date, setCookie "2", setCookie "1"] + + -- Request Headers + testReqHdrs + "KeepOnly works as expected (present | request)" + -- "Alt-Svc" has (KeepOnly "clear") + [ date, altSvc "wrong", altSvc "clear", altSvc "wrong again", host ] + [ altSvc "clear", date, host ] + testReqHdrs + "KeepOnly works as expected ( absent | request)" + -- "Alt-Svc" has (KeepOnly "clear"), but will combine when there's no "clear" (AND keeps order) + [ date, altSvc "wrong", altSvc "not clear", altSvc "wrong again", host ] + [ altSvc "wrong, not clear, wrong again", date, host ] + + -- Response Headers + testResHdrs + "KeepOnly works as expected (present | response)" + -- "If-None-Match" has (KeepOnly "*") + [ date, ifNoneMatch "wrong", ifNoneMatch "*", ifNoneMatch "wrong again", host ] + [ date, host, ifNoneMatch "*" ] + testResHdrs + "KeepOnly works as expected ( absent | response)" + -- "If-None-Match" has (KeepOnly "*"), but will combine when there's no "*" (AND keeps order) + [ date, ifNoneMatch "wrong", ifNoneMatch "not *", ifNoneMatch "wrong again", host ] + [ date, host, ifNoneMatch "wrong, not *, wrong again" ] + + -- Request Headers + testReqHdrs + "Technically acceptable headers get combined correctly (request)" + [ ifNoneMatch "correct, ", ifNoneMatch "something else \t", ifNoneMatch "and more , "] + [ ifNoneMatch "correct, something else, and more" ] + -- Response Headers + testResHdrs + "Technically acceptable headers get combined correctly (response)" + [ altSvc "correct\t, ", altSvc "something else", altSvc "and more, , "] + [ altSvc "correct, something else, and more" ] + +combineHdrs :: Header -> Header -> Header +combineHdrs (hname, h1) (_, h2) = (hname, h1 <> ", " <> h2) + +acceptHtml, + acceptJSON, + cacheControlMax, + cacheControlPublic, + contentTypeHtml, + date, + expires, + host, + location, + userAgent :: Header + +acceptHtml = (hAccept, "text/html") +acceptJSON = (hAccept, "application/json") +altSvc :: ByteString -> Header +altSvc x = ("Alt-Svc", x) +cacheControlPublic = (hCacheControl, "public") +cacheControlMax = (hCacheControl, "public") +contentTypeHtml = (hContentType, "text/html") +date = (hDate, "Mon, 19 Aug 2022 18:18:31 GMT") +expires = (hExpires, "Mon, 19 Sep 2022 18:18:31 GMT") +host = (hHost, "google.com") +ifNoneMatch :: ByteString -> Header +ifNoneMatch x = (hIfNoneMatch, x) +location = (hLocation, "http://www.google.com/";) +setCookie :: ByteString -> Header +setCookie val = (hSetCookie, val) +userAgent = (hUserAgent, "curl/7.68.0") + +runApp :: CombineSettings -> RequestHeaders -> ResponseHeaders -> IO (RequestHeaders, ResponseHeaders) +runApp settings reqHeaders resHeaders = do + reqHdrs <- newIORef $ error "IORef not set" + sResponse <- runSession + session + $ combineHeaders settings $ app reqHdrs + finalReqHeaders <- readIORef reqHdrs + pure (finalReqHeaders, simpleHeaders sResponse) + where + session = + request + defaultRequest { requestHeaders = reqHeaders } + app hdrRef req respond = do + writeIORef hdrRef $ requestHeaders req + respond $ responseLBS status200 resHeaders "" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/test/Network/Wai/ParseSpec.hs new/wai-extra-3.1.13.0/test/Network/Wai/ParseSpec.hs --- old/wai-extra-3.1.12.1/test/Network/Wai/ParseSpec.hs 2022-04-18 09:12:07.000000000 +0200 +++ new/wai-extra-3.1.13.0/test/Network/Wai/ParseSpec.hs 2022-09-11 14:48:49.000000000 +0200 @@ -12,12 +12,8 @@ import qualified Data.IORef as I import qualified Data.Text as TS import qualified Data.Text.Encoding as TE -#if MIN_VERSION_http2(3,0,0) -import Network.HTTP2.Frame (ErrorCodeId (..), HTTP2Error (..)) -#else -import Network.HTTP2 (ErrorCodeId (..), HTTP2Error (..)) -#endif import Network.Wai (Request (requestBody, requestHeaders), defaultRequest) +import Network.Wai.Handler.Warp (InvalidRequest(..)) import System.IO (IOMode (ReadMode), withFile) import Test.HUnit (Assertion, (@=?), (@?=)) import Test.Hspec @@ -101,10 +97,6 @@ let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")] let expected3 = (expectedsmap3, expectedfile3) - let unknownErrorException c (ConnectionError (UnknownErrorCode code) _) = c == code - unknownErrorException _ _ = False - - let def = defaultParseRequestBodyOptions it "parsing actual post multipart/form-data" $ do result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3 @@ -130,20 +122,20 @@ it "exceeding file size" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content3 (parseRequestBodyEx ( setMaxRequestFileSize 2 def ) lbsBackEnd req4) - `shouldThrow` unknownErrorException 413 + `shouldThrow` (== PayloadTooLarge) it "exceeding total file size" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content3 (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req4) - `shouldThrow` unknownErrorException 413 + `shouldThrow` (== PayloadTooLarge) SRequest req5 _bod5 <- toRequest'' ctype3 content5 (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req5) - `shouldThrow` unknownErrorException 413 + `shouldThrow` (== PayloadTooLarge) it "exceeding max parm value size" $ do SRequest req4 _bod4 <- toRequest'' ctype2 content2 (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req4) - `shouldThrow` unknownErrorException 413 + `shouldThrow` (== PayloadTooLarge) it "exceeding max header lines" $ do SRequest req4 _bod4 <- toRequest'' ctype2 content2 @@ -152,7 +144,7 @@ it "exceeding header line size" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content4 (parseRequestBodyEx ( setMaxHeaderLineLength 8190 def ) lbsBackEnd req4) - `shouldThrow` unknownErrorException 431 + `shouldThrow` (== RequestHeaderFieldsTooLarge) it "Testing parseRequestBodyEx with application/x-www-form-urlencoded" $ do let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.1.12.1/wai-extra.cabal new/wai-extra-3.1.13.0/wai-extra.cabal --- old/wai-extra-3.1.12.1/wai-extra.cabal 2022-05-14 20:06:11.000000000 +0200 +++ new/wai-extra-3.1.13.0/wai-extra.cabal 2022-11-01 07:19:06.000000000 +0100 @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.1.12.1 +Version: 3.1.13.0 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality: @@ -27,6 +27,10 @@ . Clean a request path to a canonical form. . + * Combine Headers + . + Combine duplicate headers into one. + . * GZip Compression . Negotiate HTTP payload gzip compression. @@ -98,31 +102,31 @@ Library Build-Depends: base >= 4.12 && < 5 + , aeson + , ansi-terminal + , base64-bytestring , bytestring >= 0.10.4 - , wai >= 3.0.3.0 && < 3.3 - , time >= 1.1.4 - , network >= 2.6.1.0 - , directory >= 1.2.7.0 - , transformers >= 0.2.2 - , http-types >= 0.7 - , text >= 0.7 + , call-stack , case-insensitive >= 0.2 + , containers + , cookie , data-default-class + , directory >= 1.2.7.0 , fast-logger >= 2.4.5 - , wai-logger >= 2.3.7 - , ansi-terminal - , resourcet >= 0.4.6 && < 1.3 - , containers - , base64-bytestring - , word8 + , http-types >= 0.7 + , HUnit + , iproute >= 1.7.8 + , network >= 2.6.1.0 + , resourcet >= 0.4.6 && < 1.4 , streaming-commons >= 0.2 - , cookie + , text >= 0.7 + , time >= 1.1.4 + , transformers >= 0.2.2 , vault - , aeson - , iproute >= 1.7.8 - , http2 - , HUnit - , call-stack + , wai >= 3.0.3.0 && < 3.3 + , wai-logger >= 2.3.7 + , warp >= 3.3.22 + , word8 if os(windows) cpp-options: -DWINDOWS @@ -131,7 +135,9 @@ default-extensions: OverloadedStrings - Exposed-modules: Network.Wai.Handler.CGI + Exposed-modules: Network.Wai.EventSource + Network.Wai.EventSource.EventStream + Network.Wai.Handler.CGI Network.Wai.Handler.SCGI Network.Wai.Header Network.Wai.Middleware.AcceptOverride @@ -139,35 +145,35 @@ Network.Wai.Middleware.Approot Network.Wai.Middleware.Autohead Network.Wai.Middleware.CleanPath - Network.Wai.Middleware.HealthCheckEndpoint - Network.Wai.Middleware.Local - Network.Wai.Middleware.RequestLogger - Network.Wai.Middleware.RequestLogger.JSON - Network.Wai.Middleware.Select + Network.Wai.Middleware.CombineHeaders + Network.Wai.Middleware.ForceDomain + Network.Wai.Middleware.ForceSSL Network.Wai.Middleware.Gzip + Network.Wai.Middleware.HealthCheckEndpoint + Network.Wai.Middleware.HttpAuth Network.Wai.Middleware.Jsonp + Network.Wai.Middleware.Local Network.Wai.Middleware.MethodOverride Network.Wai.Middleware.MethodOverridePost + Network.Wai.Middleware.RealIp + Network.Wai.Middleware.RequestLogger + Network.Wai.Middleware.RequestLogger.JSON + Network.Wai.Middleware.RequestSizeLimit + Network.Wai.Middleware.RequestSizeLimit.Internal Network.Wai.Middleware.Rewrite - Network.Wai.Middleware.StripHeaders - Network.Wai.Middleware.Vhost - Network.Wai.Middleware.HttpAuth - Network.Wai.Middleware.StreamFile - Network.Wai.Middleware.ForceDomain - Network.Wai.Middleware.ForceSSL Network.Wai.Middleware.Routed + Network.Wai.Middleware.Select + Network.Wai.Middleware.StreamFile + Network.Wai.Middleware.StripHeaders Network.Wai.Middleware.Timeout - Network.Wai.Middleware.RealIp + Network.Wai.Middleware.Vhost Network.Wai.Parse Network.Wai.Request - Network.Wai.UrlMap Network.Wai.Test Network.Wai.Test.Internal - Network.Wai.EventSource - Network.Wai.EventSource.EventStream - Network.Wai.Middleware.RequestSizeLimit - Network.Wai.Middleware.RequestSizeLimit.Internal + Network.Wai.UrlMap other-modules: Network.Wai.Middleware.RequestLogger.Internal + Network.Wai.Util default-language: Haskell2010 ghc-options: -Wall @@ -177,12 +183,12 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall if flag(build-example) build-depends: base + , bytestring + , http-types + , time + , wai , wai-extra , warp - , wai - , time - , http-types - , bytestring else buildable: False default-language: Haskell2010 @@ -191,10 +197,8 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - other-modules: Network.Wai.TestSpec - Network.Wai.ParseSpec - Network.Wai.RequestSpec - Network.Wai.Middleware.ApprootSpec + other-modules: Network.Wai.Middleware.ApprootSpec + Network.Wai.Middleware.CombineHeadersSpec Network.Wai.Middleware.ForceSSLSpec Network.Wai.Middleware.RealIpSpec Network.Wai.Middleware.RequestSizeLimitSpec @@ -202,27 +206,30 @@ Network.Wai.Middleware.SelectSpec Network.Wai.Middleware.StripHeadersSpec Network.Wai.Middleware.TimeoutSpec + Network.Wai.ParseSpec + Network.Wai.RequestSpec + Network.Wai.TestSpec WaiExtraSpec + build-tool-depends: hspec-discover:hspec-discover build-depends: base >= 4 && < 5 - , wai-extra - , wai - , hspec >= 1.3 - , transformers - , fast-logger - , http-types - , zlib - , text - , resourcet + , aeson , bytestring - , HUnit , cookie - , time , case-insensitive - , http2 - , aeson + , directory + , fast-logger + , hspec >= 1.3 + , http-types + , HUnit , iproute + , resourcet , temporary - , directory + , text + , time + , wai-extra + , wai + , warp + , zlib ghc-options: -Wall default-language: Haskell2010 ++++++ wai-extra.cabal ++++++ Name: wai-extra Version: 3.1.13.0 x-revision: 1 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality: . * WAI Testing Framework . Hspec testing facilities and helpers for WAI. . * Event Source/Event Stream . Send server events to the client. Compatible with the JavaScript EventSource API. . * Accept Override . Override the Accept header in a request. Special handling for the _accept query parameter (which is used throughout WAI override the Accept header). . * Add Headers . WAI Middleware for adding arbitrary headers to an HTTP request. . * Clean Path . Clean a request path to a canonical form. . * Combine Headers . Combine duplicate headers into one. . * GZip Compression . Negotiate HTTP payload gzip compression. . * Health check endpoint . Add an empty health check endpoint. . * HTTP Basic Authentication . WAI Basic Authentication Middleware which uses Authorization header. . * JSONP . \"JSON with Padding\" middleware. Automatic wrapping of JSON responses to convert into JSONP. . * Method Override / Post . Allows overriding of the HTTP request method via the _method query string parameter. . * Request Logging . Request logging middleware for development and production environments . * Request Rewrite . Rewrite request path info based on a custom conversion rules. . * Select . Dynamically choose between Middlewares. . * Stream Files . Convert ResponseFile type responses into ResponseStream type. . * Virtual Host . Redirect incoming requests to a new host based on custom rules. . . API docs and the README are available at <http://www.stackage.org/package/wai-extra>. License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: [email protected] Homepage: http://github.com/yesodweb/wai Category: Web Build-Type: Simple Cabal-Version: >=1.10 Stability: Stable extra-source-files: test/requests/dalvik-request test/json test/json.gz test/noprecompress test/test.html test/sample.hs ChangeLog.md README.md flag build-example description: Build example executable. manual: True default: False Library Build-Depends: base >= 4.12 && < 5 , aeson , ansi-terminal >= 0.4 , base64-bytestring , bytestring >= 0.10.4 , call-stack , case-insensitive >= 0.2 , containers , cookie , data-default-class , directory >= 1.2.7.0 , fast-logger >= 2.4.5 , http-types >= 0.7 , HUnit , iproute >= 1.7.8 , network >= 2.6.1.0 , resourcet >= 0.4.6 && < 1.4 , streaming-commons >= 0.2 , text >= 0.7 , time >= 1.1.4 , transformers >= 0.2.2 , vault , wai >= 3.2.2.1 && < 3.3 , wai-logger >= 2.3.7 , warp >= 3.3.22 , word8 if os(windows) cpp-options: -DWINDOWS else build-depends: unix default-extensions: OverloadedStrings Exposed-modules: Network.Wai.EventSource Network.Wai.EventSource.EventStream Network.Wai.Handler.CGI Network.Wai.Handler.SCGI Network.Wai.Header Network.Wai.Middleware.AcceptOverride Network.Wai.Middleware.AddHeaders Network.Wai.Middleware.Approot Network.Wai.Middleware.Autohead Network.Wai.Middleware.CleanPath Network.Wai.Middleware.CombineHeaders Network.Wai.Middleware.ForceDomain Network.Wai.Middleware.ForceSSL Network.Wai.Middleware.Gzip Network.Wai.Middleware.HealthCheckEndpoint Network.Wai.Middleware.HttpAuth Network.Wai.Middleware.Jsonp Network.Wai.Middleware.Local Network.Wai.Middleware.MethodOverride Network.Wai.Middleware.MethodOverridePost Network.Wai.Middleware.RealIp Network.Wai.Middleware.RequestLogger Network.Wai.Middleware.RequestLogger.JSON Network.Wai.Middleware.RequestSizeLimit Network.Wai.Middleware.RequestSizeLimit.Internal Network.Wai.Middleware.Rewrite Network.Wai.Middleware.Routed Network.Wai.Middleware.Select Network.Wai.Middleware.StreamFile Network.Wai.Middleware.StripHeaders Network.Wai.Middleware.Timeout Network.Wai.Middleware.Vhost Network.Wai.Parse Network.Wai.Request Network.Wai.Test Network.Wai.Test.Internal Network.Wai.UrlMap other-modules: Network.Wai.Middleware.RequestLogger.Internal Network.Wai.Util default-language: Haskell2010 ghc-options: -Wall executable example hs-source-dirs: example main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall if flag(build-example) build-depends: base , bytestring , http-types , time , wai , wai-extra , warp else buildable: False default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: Network.Wai.Middleware.ApprootSpec Network.Wai.Middleware.CombineHeadersSpec Network.Wai.Middleware.ForceSSLSpec Network.Wai.Middleware.RealIpSpec Network.Wai.Middleware.RequestSizeLimitSpec Network.Wai.Middleware.RoutedSpec Network.Wai.Middleware.SelectSpec Network.Wai.Middleware.StripHeadersSpec Network.Wai.Middleware.TimeoutSpec Network.Wai.ParseSpec Network.Wai.RequestSpec Network.Wai.TestSpec WaiExtraSpec build-tool-depends: hspec-discover:hspec-discover build-depends: base >= 4 && < 5 , aeson , bytestring , cookie , case-insensitive , directory , fast-logger , hspec >= 1.3 , http-types , HUnit , iproute , resourcet , temporary , text , time , wai-extra , wai , warp , zlib ghc-options: -Wall default-language: Haskell2010 if os(windows) cpp-options: -DWINDOWS source-repository head type: git location: git://github.com/yesodweb/wai.git
