Merge remote-tracking branch 'origin/master' into rio

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)

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

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

yesod-core/src/Yesod/Core/Internal/Run.hs

@@ -297,9 +297,11 @@ yesodRunner :: (ToTypedContent res, Yesod site)
             -> YesodRunnerEnv site
             -> Maybe (Route site)
             -> Application
-yesodRunner handler' YesodRunnerEnv {..} route req sendResponse
+yesodRunner handler' YesodRunnerEnv {..} route req sendResponse = do
-  | Just maxLen <- mmaxLen, KnownLength len <- requestBodyLength req, maxLen < len = sendResponse (tooLargeResponse maxLen len)
+  mmaxLen <- maximumContentLengthIO yreSite route
-  | otherwise = do
+  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

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 <michael@snoyman.com>

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'.