diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 84f814d0..5641afee 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -4,6 +4,10 @@ * Switch over to using `rio` +## 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) diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs index f3122e57..50aacada 100644 --- a/yesod-core/src/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs @@ -189,6 +189,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. -- @@ -196,6 +197,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 + -- | Get the 'LogFunc' from the foundation type. -- -- If this function returns a @Nothing@ (the default), the Yesod 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 6dc6bab6..4412cbd0 100644 --- a/yesod-core/src/Yesod/Core/Internal/Run.hs +++ b/yesod-core/src/Yesod/Core/Internal/Run.hs @@ -297,42 +297,44 @@ 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 -- 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 - , rheLogFunc = yreLogFunc - , rheOnError = safeEh yreLogFunc - , 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 -- 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 + , rheLogFunc = yreLogFunc + , rheOnError = safeEh yreLogFunc + , 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 1b80c586..2c98ff9a 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 diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index 6b9d58d7..4467c2cb 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -41,6 +41,15 @@ type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerFor site) class Monad (YesodDB site) => YesodPersist site where type YesodPersistBackend site + -- | Allows you to execute database actions within Yesod Handlers. For databases that support it, code inside the action will run as an atomic transaction. + -- + -- + -- ==== __Example Usage__ + -- + -- > userId <- runDB $ do + -- > userId <- insert $ User "username" "email@example.com" + -- > insert_ $ UserPreferences userId True + -- > pure userId runDB :: YesodDB site a -> HandlerFor site a -- | Helper for creating 'runDB'.