Merge remote-tracking branch 'origin/master' into better-monads

This commit is contained in:
Michael Snoyman 2018-02-02 00:17:37 +02:00
commit 6ad81f6d15
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
4 changed files with 19 additions and 5 deletions

3
.gitignore vendored
View File

@ -21,3 +21,6 @@ tarballs/
.ghc
.stackage
.bash_history
# OS X
.DS_Store

View File

@ -12,6 +12,10 @@
* Overhaul of `HandlerT`/`WidgetT` to no longer be transformers.
* Fix Haddock comment & simplify implementation for `contentTypeTypes` [#1476](https://github.com/yesodweb/yesod/issues/1476)
## 1.4.37.3
* Improve error message when request body is too large [#1477](https://github.com/yesodweb/yesod/pull/1477)
## 1.4.37.2
* Improve error messages for the CSRF checking functions [#1455](https://github.com/yesodweb/yesod/issues/1455)

View File

@ -25,6 +25,7 @@ import qualified Network.Wai as W
import Web.Cookie (parseCookiesText)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as LS8
import Data.Text (Text, pack)
import Network.HTTP.Types (queryToQueryText, Status (Status))
import Data.Maybe (fromMaybe, catMaybes)
@ -55,17 +56,23 @@ limitRequestBody maxLen req = do
let len = fromIntegral $ S8.length bs
remaining' = remaining - len
if remaining < len
then throwIO $ HCWai tooLargeResponse
then throwIO $ HCWai $ tooLargeResponse maxLen len
else do
writeIORef ref remaining'
return bs
}
tooLargeResponse :: W.Response
tooLargeResponse = W.responseLBS
tooLargeResponse :: Word64 -> Word64 -> W.Response
tooLargeResponse maxLen bodyLen = W.responseLBS
(Status 413 "Too Large")
[("Content-Type", "text/plain")]
"Request body too large to be processed."
(L.concat
[ "Request body too large to be processed. The maximum size is "
, (LS8.pack (show maxLen))
, " bytes; your request body was "
, (LS8.pack (show bodyLen))
, " bytes. If you're the developer of this site, you can configure the maximum length with the `maximumContentLength` function on the Yesod typeclass."
])
parseWaiRequest :: W.Request
-> SessionMap

View File

@ -311,7 +311,7 @@ yesodRunner :: (ToTypedContent res, Yesod site)
-> Maybe (Route site)
-> Application
yesodRunner handler' YesodRunnerEnv {..} route req sendResponse
| Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse tooLargeResponse
| Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse (tooLargeResponse maxLen len)
| otherwise = do
let dontSaveSession _ = return []
(session, saveSession) <- liftIO $