maximumContentLengthIO

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

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

@@ -303,43 +303,45 @@ 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
-    let dontSaveSession _ = return []
+    (Just maxLen, KnownLength len) | maxLen < len -> sendResponse (tooLargeResponse maxLen len)
-    (session, saveSession) <- liftIO $
+    _ -> do
-        maybe (return (Map.empty, dontSaveSession)) (`sbLoadSession` req) yreSessionBackend
+      let dontSaveSession _ = return []
-    maxExpires <- yreGetMaxExpires
+      (session, saveSession) <- liftIO $
-    let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) mmaxLen
+          maybe (return (Map.empty, dontSaveSession)) (`sbLoadSession` req) yreSessionBackend
-    let yreq =
+      maxExpires <- yreGetMaxExpires
-            case mkYesodReq of
+      let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) mmaxLen
-                Left yreq' -> yreq'
+      let yreq =
-                Right needGen -> needGen yreGen
+              case mkYesodReq of
-    let ra = resolveApproot yreSite req
+                  Left yreq' -> yreq'
-    let log' = messageLoggerSource yreSite yreLogger
+                  Right needGen -> needGen yreGen
-        -- We set up two environments: the first one has a "safe" error handler
+      let ra = resolveApproot yreSite req
-        -- which will never throw an exception. The second one uses the
+      let log' = messageLoggerSource yreSite yreLogger
-        -- user-provided errorHandler function. If that errorHandler function
+          -- We set up two environments: the first one has a "safe" error handler
-        -- errors out, it will use the safeEh below to recover.
+          -- which will never throw an exception. The second one uses the
-        rheSafe = RunHandlerEnv
+          -- user-provided errorHandler function. If that errorHandler function
-            { rheRender = yesodRender yreSite ra
+          -- errors out, it will use the safeEh below to recover.
-            , rheRoute = route
+          rheSafe = RunHandlerEnv
-            , rheRouteToMaster = id
+              { rheRender = yesodRender yreSite ra
-            , rheChild = yreSite
+              , rheRoute = route
-            , rheSite = yreSite
+              , rheRouteToMaster = id
-            , rheUpload = fileUpload yreSite
+              , rheChild = yreSite
-            , rheLog = log'
+              , rheSite = yreSite
-            , rheOnError = safeEh log'
+              , rheUpload = fileUpload yreSite
-            , rheMaxExpires = maxExpires
+              , rheLog = log'
-            }
+              , rheOnError = safeEh log'
-        rhe = rheSafe
+              , rheMaxExpires = maxExpires
-            { rheOnError = runHandler rheSafe . errorHandler
+              }
-            }
+          rhe = rheSafe
+              { rheOnError = runHandler rheSafe . errorHandler
+              }
 
-    yesodWithInternalState yreSite route $ \is -> do
+      yesodWithInternalState yreSite route $ \is -> do
-        yreq' <- yreq
+          yreq' <- yreq
-        yar <- runInternalState (runHandler rhe handler yreq') is
+          yar <- runInternalState (runHandler rhe handler yreq') is
-        yarToResponse yar saveSession yreq' req is sendResponse
+          yarToResponse yar saveSession yreq' req is sendResponse
   where
     mmaxLen = maximumContentLength yreSite route
     handler = yesodMiddleware handler'

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>