diff --git a/yesod-core/src/Yesod/Core/Internal/Run.hs b/yesod-core/src/Yesod/Core/Internal/Run.hs index 6ad7cd3f..a7530eb5 100644 --- a/yesod-core/src/Yesod/Core/Internal/Run.hs +++ b/yesod-core/src/Yesod/Core/Internal/Run.hs @@ -70,7 +70,6 @@ unsafeAsyncCatch -> (e -> m a) -- ^ handler -> m a unsafeAsyncCatch f g = withRunInIO $ \run -> run f `EUnsafe.catch` \e -> do - liftIO Sync.disableAllocationLimit -- otherwise it can throw again on rendering the 500 page run (g e) -- | Convert a synchronous exception into an ErrorResponse @@ -97,7 +96,7 @@ basicRunHandler :: ToTypedContent c -> YesodRequest -> InternalState -> IO (GHState, HandlerContents) -basicRunHandler rhe handler yreq resState = do +basicRunHandler rhe handler yreq resState = mask $ \unmask -> do -- Create a mutable ref to hold the state. We use mutable refs so -- that the updates will survive runtime exceptions. istate <- I.newIORef defState @@ -105,7 +104,7 @@ basicRunHandler rhe handler yreq resState = do -- Run the handler itself, capturing any runtime exceptions and -- converting them into a @HandlerContents@ contents' <- unsafeAsyncCatch - (do + (unmask $ do res <- unHandlerFor handler (hd istate) tc <- evaluate (toTypedContent res) -- Success! Wrap it up in an @HCContent@ @@ -219,9 +218,9 @@ runHandler :: ToTypedContent c => RunHandlerEnv site site -> HandlerFor site c -> YesodApp -runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> do +runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> mask $ \unmask -> do -- Get the raw state and original contents - (state, contents0) <- basicRunHandler rhe handler yreq resState + (state, contents0) <- unmask $ basicRunHandler rhe handler yreq resState -- Evaluate the unfortunately-lazy session and headers, -- propagating exceptions into the contents diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 218d5634..4605fd40 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -17,6 +17,7 @@ import Network.Wai.Test import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 import Control.Exception (SomeException, try) +import UnliftIO.Exception(finally) import Network.HTTP.Types (Status, mkStatus) import Data.ByteString.Builder (Builder, toLazyByteString) import Data.Monoid (mconcat) @@ -119,14 +120,15 @@ getGoodBuilderR :: Handler TypedContent getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent getAlocationLimitR :: Handler Html -getAlocationLimitR = do +getAlocationLimitR = + (do liftIO $ do Mem.setAllocationCounter 1 -- very low limit Mem.enableAllocationLimit defaultLayout $ [whamlet|
this will trigger https://hackage.haskell.org/package/base-4.16.0.0/docs/Control-Exception.html#t:AllocationLimitExceeded which we need to catch - |] + |]) `finally` (liftIO $ Mem.disableAllocationLimit) -- this handler kills it's own thread getThreadKilledR :: Handler Html