302726b · typeable/wai

git.iko.soy/typeable/wai

Fix for #647 (Payload Too Large in WAI is 500 instead of 413)

- Instead of 'error "Header line length exceeds allowed maximum."' throw 'ConnectionError (UnknownErrorCode 431) "Request Header Fields Too Large"' - Instead of 'error "Maximum size exceeded"' throw 'ConnectionError (UnknownErrorCode 413) "Payload Too Large"' Before submitting your PR, I have: - [X] Bumped the version number - [X] Added Since declarations to the Haddock After submitting PR, I have: - [X] Update the Changelog.md file with a link to your PR - [X] Check that CI passes (except lts-6 and lts-9) On Windows stack-lts-13 1 test fails 1) Run streaming response with length expected: "HelloHelloHelloHello" but got: "Bad Request" Runs fine on Linux and mac.

commit302726b8159c09ba36e1f8006dd72b1188c34cc7 authorvlatkoB <vlatko.basic@gmail.com> dateWed 24 Apr 2019, 07:43 (7 years ago) parent954b646

7 files changed+61−15

compare with master

unifiedsplit

wai-extra/ChangeLog.md+6 wai-extra/Network/Wai/Parse.hs+11−4 wai-extra/test/Network/Wai/ParseSpec.hs+14−5 wai-extra/wai-extra.cabal+3−1 warp/ChangeLog.md+4 warp/Network/Wai/Handler/Warp/Settings.hs+22−4 warp/warp.cabal+1−1

wai-extra/ChangeLog.md+6

@@ -1,5 +1,11 @@

11# Changelog for wai-extra

3+## 3.0.26

5+* Throw 413 for too large payload

6+* Throw 431 for too large headers

7+ [#741](https://github.com/yesodweb/wai/pull/741)

39## 3.0.25

410

511* Supporting `network` version 3.0.

wai-extra/Network/Wai/Parse.hs+11−4

@@ -48,6 +48,7 @@ module Network.Wai.Parse

4848#endif

4949 ) where

5050

51+import qualified Control.Exception as E

5152import qualified Data.ByteString as S

5253import qualified Data.ByteString.Lazy as L

5354import qualified Data.ByteString.Char8 as S8

@@ -67,6 +68,7 @@ import Control.Monad (when, unless, guard)

6768import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)

6869import Data.IORef

6970import Network.HTTP.Types (hContentType)

71+import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )

7072import Data.CaseInsensitive (mk)

7173

7274import Prelude hiding (lines)

@@ -426,6 +428,8 @@ conduitRequestBodyEx o backend (Multipart bound) rbody add =

426428

427429

428430-- | Take one header or subheader line.

431+-- Since: 3.0.26

432+-- Throw 431 if headers too large.

429433takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)

430434takeLine maxlen src =

431435 go ""

@@ -434,7 +438,8 @@ takeLine maxlen src =

434438 bs <- readSource src

435439 case maxlen of

436440 Just maxlen' -> when (S.length front > maxlen') $

437− error "Header line length exceeds allowed maximum."

441+ E.throwIO $ ConnectionError (UnknownErrorCode 431)

442+ "Request Header Fields Too Large"

438443 Nothing -> return ()

439444 if S.null bs

440445 then close front

@@ -450,7 +455,8 @@ takeLine maxlen src =

450455 let res = front `S.append` x

451456 case maxlen of

452457 Just maxlen' -> when (S.length res > maxlen') $

453− error "Header line length exceeds allowed maximum."

458+ E.throwIO $ ConnectionError (UnknownErrorCode 431)

459+ "Request Header Fields Too Large"

454460 Nothing -> return ()

455461 return $ Just $ killCR $ res

456462

@@ -639,8 +645,9 @@ wrapTillBound bound src max' = do

639645 cur <- atomicModifyIORef' sref $ \ cur ->

640646 let new = cur + fromIntegral (S.length bs) in (new, new)

641647 case max' of

642− Just max'' | cur > max'' -> error "Maximum size exceeded"

643− _ -> return ()

648+ Just max'' | cur > max'' ->

649+ E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"

650+ _ -> return ()

644651 if S.null bs

645652 then do

646653 writeIORef ref $ WTBDone False

wai-extra/test/Network/Wai/ParseSpec.hs+14−5

@@ -13,6 +13,7 @@ import qualified Data.ByteString.Lazy as L

1313import qualified Data.Text as TS

1414import qualified Data.Text.Encoding as TE

1515import Control.Monad.Trans.Resource (withInternalState, runResourceT)

16+import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )

1617

1718import Network.Wai

1819import Network.Wai.Test

@@ -94,6 +95,9 @@ caseParseRequestBody = do

9495 let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]

9596 let expected3 = (expectedsmap3, expectedfile3)

9697

98+ let unknownErrorException c (ConnectionError (UnknownErrorCode code) _) = c == code

99+ unknownErrorException _ _ = False

100+

97101

98102 let def = defaultParseRequestBodyOptions

99103 it "parsing actual post multipart/form-data" $ do

@@ -119,17 +123,21 @@ caseParseRequestBody = do

119123

120124 it "exceeding file size" $ do

121125 SRequest req4 _bod4 <- toRequest'' ctype3 content3

122− (parseRequestBodyEx ( setMaxRequestFileSize 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall

126+ (parseRequestBodyEx ( setMaxRequestFileSize 2 def ) lbsBackEnd req4)

127+ `shouldThrow` unknownErrorException 413

123128

124129 it "exceeding total file size" $ do

125130 SRequest req4 _bod4 <- toRequest'' ctype3 content3

126− (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall

131+ (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req4)

132+ `shouldThrow` unknownErrorException 413

127133 SRequest req5 _bod5 <- toRequest'' ctype3 content5

128− (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req5) `shouldThrow` anyErrorCall

134+ (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req5)

135+ `shouldThrow` unknownErrorException 413

129136

130137 it "exceeding max parm value size" $ do

131138 SRequest req4 _bod4 <- toRequest'' ctype2 content2

132− (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall

139+ (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req4)

140+ `shouldThrow` unknownErrorException 413

133141

134142 it "exceeding max header lines" $ do

135143 SRequest req4 _bod4 <- toRequest'' ctype2 content2

@@ -137,7 +145,8 @@ caseParseRequestBody = do

137145

138146 it "exceeding header line size" $ do

139147 SRequest req4 _bod4 <- toRequest'' ctype3 content4

140− (parseRequestBodyEx ( setMaxHeaderLineLength 8190 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall

148+ (parseRequestBodyEx ( setMaxHeaderLineLength 8190 def ) lbsBackEnd req4)

149+ `shouldThrow` unknownErrorException 431

141150

142151 it "Testing parseRequestBodyEx with application/x-www-form-urlencoded" $ do

143152 let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou"

wai-extra/wai-extra.cabal+3−1

@@ -1,5 +1,5 @@

11Name: wai-extra

2−Version: 3.0.25

2+Version: 3.0.26

33Synopsis: Provides some basic WAI handlers and middleware.

44description:

55 Provides basic WAI handler and middleware functionality:

@@ -115,6 +115,7 @@ Library

115115 , zlib

116116 , aeson

117117 , iproute

118+ , http2

118119

119120 if os(windows)

120121 cpp-options: -DWINDOWS

@@ -202,6 +203,7 @@ test-suite spec

202203 , cookie

203204 , time

204205 , case-insensitive

206+ , http2

205207 ghc-options: -Wall

206208 default-language: Haskell2010

207209

warp/ChangeLog.md+4

@@ -4,6 +4,10 @@

44 value of the `PORT` environment variable

55 [#736](https://github.com/yesodweb/wai/pull/736)

7+* Throw 413 for too large payload

8+* Throw 431 for too large headers

9+ [#741](https://github.com/yesodweb/wai/pull/741)

10+

711## 3.2.26

812

913* Support network package version 3

warp/Network/Wai/Handler/Warp/Settings.hs+22−4

@@ -8,12 +8,14 @@ import Control.Concurrent (forkIOWithUnmask)

88import Control.Exception

99import Data.ByteString.Builder (byteString)

1010import qualified Data.ByteString.Char8 as C8

11+import Data.ByteString.Lazy (fromStrict)

1112import Data.Streaming.Network (HostPreference)

1213import qualified Data.Text as T

1314import qualified Data.Text.IO as TIO

1415import Data.Version (showVersion)

1516import GHC.IO.Exception (IOErrorType(..))

1617import qualified Network.HTTP.Types as H

18+import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )

1719import Network.Socket (SockAddr)

1820import Network.Wai

1921import qualified Paths_warp

@@ -168,13 +170,29 @@ defaultOnException _ e =

168170 when (defaultShouldDisplayException e)

169171 $ TIO.hPutStrLn stderr $ T.pack $ show e

170172

171−-- | Sending 400 for bad requests. Sending 500 for internal server errors.

172−--

173+-- | Sending 400 for bad requests.

174+-- Sending 500 for internal server errors.

173175-- Since: 3.1.0

176+-- Sending 413 for too large payload.

177+-- Sending 431 for too large headers.

178+-- Since 3.2.27

174179defaultOnExceptionResponse :: SomeException -> Response

175180defaultOnExceptionResponse e

176− | Just (_ :: InvalidRequest) <- fromException e = responseLBS H.badRequest400 [(H.hContentType, "text/plain; charset=utf-8")] "Bad Request"

177− | otherwise = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"

181+ | Just (_ :: InvalidRequest) <-

182+ fromException e = responseLBS H.badRequest400

183+ [(H.hContentType, "text/plain; charset=utf-8")]

184+ "Bad Request"

185+ | Just (ConnectionError (UnknownErrorCode 413) t) <-

186+ fromException e = responseLBS H.status413

187+ [(H.hContentType, "text/plain; charset=utf-8")]

188+ (fromStrict t)

189+ | Just (ConnectionError (UnknownErrorCode 431) t) <-

190+ fromException e = responseLBS H.status431

191+ [(H.hContentType, "text/plain; charset=utf-8")]

192+ (fromStrict t)

193+ | otherwise = responseLBS H.internalServerError500

194+ [(H.hContentType, "text/plain; charset=utf-8")]

195+ "Something went wrong"

178196

179197-- | Exception handler for the debugging purpose.

180198-- 500, text/plain, a showed exception.

warp/warp.cabal+1−1

@@ -1,5 +1,5 @@

11Name: warp

2−Version: 3.2.26

2+Version: 3.2.27

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE