wai-extra 3.1.12.1 → 3.1.13.0

raw patch · 10 files changed

+555/−110 lines, 10 filesdep −http2dep ~transformersdep ~warpPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: http2

Dependency ranges changed: transformers, warp

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/Wai/Header.hs +3/−20
• Network/Wai/Middleware/CombineHeaders.hs +299/−0
• Network/Wai/Middleware/Gzip.hs +2/−1
• Network/Wai/Middleware/RequestLogger.hs +10/−4
• Network/Wai/Parse.hs +4/−11
• Network/Wai/Util.hs +26/−0
• test/Network/Wai/Middleware/CombineHeadersSpec.hs +134/−0
• test/Network/Wai/ParseSpec.hs +6/−14
• wai-extra.cabal +67/−60

@@ -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)

@@ -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@@ -30,22 +29,6 @@ replaceHeader :: H.HeaderName -> S.ByteString -> [H.Header] -> [H.Header] 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 --

@@ -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)+    ]

@@ -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 --

@@ -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

@@ -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

@@ -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

@@ -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 ""

@@ -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"

@@ -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