From 48bfe0d5735c70b2182fbae8731aa0adcf28ba42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Charvet=20=E9=BB=91=E7=93=9C?= Date: Fri, 15 Mar 2019 20:31:45 +0000 Subject: [PATCH 1/3] maximumContentLengthIO --- yesod-core/src/Yesod/Core/Class/Yesod.hs | 12 +++ yesod-core/src/Yesod/Core/Internal/Request.hs | 2 +- yesod-core/src/Yesod/Core/Internal/Run.hs | 74 ++++++++++--------- yesod-core/yesod-core.cabal | 2 +- 4 files changed, 52 insertions(+), 38 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs index df7f079b..25c1e6c6 100644 --- a/yesod-core/src/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs @@ -202,6 +202,18 @@ class RenderRoute site => Yesod site where maximumContentLength :: site -> Maybe (Route site) -> Maybe Word64 maximumContentLength _ _ = Just $ 2 * 1024 * 1024 -- 2 megabytes + -- | Maximum allowed length of the request body, in bytes. This is similar + -- to 'maximumContentLength', but the result lives in @IO@. This allows + -- you to dynamically change the maximum file size based on some external + -- source like a database or an @IORef@. + -- + -- The default implementation uses 'maximumContentLength'. Future version of yesod will + -- remove 'maximumContentLength' and use this method exclusively. + -- + -- @since 1.6.13 + maximumContentLengthIO :: site -> Maybe (Route site) -> IO (Maybe Word64) + maximumContentLengthIO a b = pure $ maximumContentLength a b + -- | Creates a @Logger@ to use for log messages. -- -- Note that a common technique (endorsed by the scaffolding) is to create diff --git a/yesod-core/src/Yesod/Core/Internal/Request.hs b/yesod-core/src/Yesod/Core/Internal/Request.hs index f9ae7531..7d34fe71 100644 --- a/yesod-core/src/Yesod/Core/Internal/Request.hs +++ b/yesod-core/src/Yesod/Core/Internal/Request.hs @@ -71,7 +71,7 @@ tooLargeResponse maxLen bodyLen = W.responseLBS , (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." + , " bytes. If you're the developer of this site, you can configure the maximum length with the `maximumContentLength` or `maximumContentLengthIO` function on the Yesod typeclass." ]) parseWaiRequest :: W.Request diff --git a/yesod-core/src/Yesod/Core/Internal/Run.hs b/yesod-core/src/Yesod/Core/Internal/Run.hs index 0b00286c..ed92f0c0 100644 --- a/yesod-core/src/Yesod/Core/Internal/Run.hs +++ b/yesod-core/src/Yesod/Core/Internal/Run.hs @@ -303,43 +303,45 @@ yesodRunner :: (ToTypedContent res, Yesod site) -> YesodRunnerEnv site -> Maybe (Route site) -> Application -yesodRunner handler' YesodRunnerEnv {..} route req sendResponse - | Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse (tooLargeResponse maxLen len) - | otherwise = do - let dontSaveSession _ = return [] - (session, saveSession) <- liftIO $ - maybe (return (Map.empty, dontSaveSession)) (`sbLoadSession` req) yreSessionBackend - maxExpires <- yreGetMaxExpires - let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) mmaxLen - let yreq = - case mkYesodReq of - Left yreq' -> yreq' - Right needGen -> needGen yreGen - let ra = resolveApproot yreSite req - let log' = messageLoggerSource yreSite yreLogger - -- We set up two environments: the first one has a "safe" error handler - -- which will never throw an exception. The second one uses the - -- user-provided errorHandler function. If that errorHandler function - -- errors out, it will use the safeEh below to recover. - rheSafe = RunHandlerEnv - { rheRender = yesodRender yreSite ra - , rheRoute = route - , rheRouteToMaster = id - , rheChild = yreSite - , rheSite = yreSite - , rheUpload = fileUpload yreSite - , rheLog = log' - , rheOnError = safeEh log' - , rheMaxExpires = maxExpires - } - rhe = rheSafe - { rheOnError = runHandler rheSafe . errorHandler - } +yesodRunner handler' YesodRunnerEnv {..} route req sendResponse = do + mmaxLen <- maximumContentLengthIO yreSite route + case (mmaxLen, requestBodyLength req) of + (Just maxLen, KnownLength len) | maxLen < len -> sendResponse (tooLargeResponse maxLen len) + _ -> do + let dontSaveSession _ = return [] + (session, saveSession) <- liftIO $ + maybe (return (Map.empty, dontSaveSession)) (`sbLoadSession` req) yreSessionBackend + maxExpires <- yreGetMaxExpires + let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) mmaxLen + let yreq = + case mkYesodReq of + Left yreq' -> yreq' + Right needGen -> needGen yreGen + let ra = resolveApproot yreSite req + let log' = messageLoggerSource yreSite yreLogger + -- We set up two environments: the first one has a "safe" error handler + -- which will never throw an exception. The second one uses the + -- user-provided errorHandler function. If that errorHandler function + -- errors out, it will use the safeEh below to recover. + rheSafe = RunHandlerEnv + { rheRender = yesodRender yreSite ra + , rheRoute = route + , rheRouteToMaster = id + , rheChild = yreSite + , rheSite = yreSite + , rheUpload = fileUpload yreSite + , rheLog = log' + , rheOnError = safeEh log' + , rheMaxExpires = maxExpires + } + rhe = rheSafe + { rheOnError = runHandler rheSafe . errorHandler + } - yesodWithInternalState yreSite route $ \is -> do - yreq' <- yreq - yar <- runInternalState (runHandler rhe handler yreq') is - yarToResponse yar saveSession yreq' req is sendResponse + yesodWithInternalState yreSite route $ \is -> do + yreq' <- yreq + yar <- runInternalState (runHandler rhe handler yreq') is + yarToResponse yar saveSession yreq' req is sendResponse where mmaxLen = maximumContentLength yreSite route handler = yesodMiddleware handler' diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 404a35fd..3e460446 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.12 +version: 1.6.13 license: MIT license-file: LICENSE author: Michael Snoyman From a691f492584afb647000cb799d490414a20c3dfe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Charvet=20=E9=BB=91=E7=93=9C?= Date: Fri, 15 Mar 2019 20:36:49 +0000 Subject: [PATCH 2/3] update changelog --- yesod-core/ChangeLog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 1006d11e..3e7f2836 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.13 + +* Introduce `maxContentLengthIO`. [issue #1588](https://github.com/yesodweb/yesod/issues/1588) and [PR #1589](https://github.com/yesodweb/yesod/pull/1589) + ## 1.6.12 * Use at most one valid session cookie per request [#1581](https://github.com/yesodweb/yesod/pull/1581) From f1374c91409f2e22a0b1cc8890e87fbbd8d7d880 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Charvet=20=E9=BB=91=E7=93=9C?= Date: Sun, 17 Mar 2019 09:10:07 +0000 Subject: [PATCH 3/3] add doc for maximumContentLength override --- yesod-core/src/Yesod/Core/Class/Yesod.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs index 25c1e6c6..df8d195b 100644 --- a/yesod-core/src/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs @@ -195,6 +195,7 @@ class RenderRoute site => Yesod site where addStaticContent _ _ _ = return Nothing -- | Maximum allowed length of the request body, in bytes. + -- This method may be ignored if 'maximumContentLengthIO' is overridden. -- -- If @Nothing@, no maximum is applied. --