Merge remote-tracking branch 'origin/master' into better-monads
This commit is contained in:
commit
6ad81f6d15
3
.gitignore
vendored
3
.gitignore
vendored
@ -21,3 +21,6 @@ tarballs/
|
||||
.ghc
|
||||
.stackage
|
||||
.bash_history
|
||||
|
||||
# OS X
|
||||
.DS_Store
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user