From 837b898b3518e3cf8cb8960c593bd3dd3f09be50 Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Wed, 6 Mar 2019 11:31:38 -0800 Subject: [PATCH 1/4] Document runDB My coworker who is new to Haskell was pointing out that for such an important function to Yesod, this one is lacking any documentation. It's slightly hard to document because people could provide various implementations for it, but I think this description captures the essence pretty well, and notes the important implicit behavior of opening a transaction. --- yesod-persistent/Yesod/Persist/Core.hs | 9 +++++++++ 1 file changed, 9 insertions(+) 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'. 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 2/4] 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 3/4] 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 4/4] 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. --