haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Test case and fix for notCaught3 in #658

Browse Source
This commit is contained in:
Michael Snoyman 2014-01-27 17:20:02 +02:00
parent b828c7c600
commit 86b7f5ea43
2 changed files with 18 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -10,7 +10,8 @@ module Yesod.Core.Internal.Run where
import Yesod.Core.Internal.Response import Yesod.Core.Internal.Response
import Blaze.ByteString.Builder (toByteString) import Blaze.ByteString.Builder (toByteString)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (fromException, bracketOnError) import Control.Exception (fromException, bracketOnError, evaluate)
import qualified Control.Exception as E
import Control.Exception.Lifted (catch) import Control.Exception.Lifted (catch)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -94,7 +95,9 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -
YRWai _ -> return yar YRWai _ -> return yar
let sendFile' ct fp p = let sendFile' ct fp p =
return $ YRPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession return $ YRPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession
case contents of contents1 <- evaluate contents `E.catch` \e -> return
(HCError $! InternalError $! T.pack $! show (e :: E.SomeException))
case contents1 of
HCContent status (TypedContent ct c) -> do HCContent status (TypedContent ct c) -> do
ec' <- liftIO $ evaluateContent c ec' <- liftIO $ evaluateContent c
case ec' of case ec' of

13
yesod-core/test/YesodCoreTest/ErrorHandling.hs
View File

@ -24,6 +24,9 @@ mkYesod "App" [parseRoutes|
/error-in-body ErrorInBodyR GET /error-in-body ErrorInBodyR GET
/error-in-body-noeval ErrorInBodyNoEvalR GET /error-in-body-noeval ErrorInBodyNoEvalR GET
/override-status OverrideStatusR GET /override-status OverrideStatusR GET
-- https://github.com/yesodweb/yesod/issues/658
/builder BuilderR GET
|] |]
overrideStatus = mkStatus 15 "OVERRIDE" overrideStatus = mkStatus 15 "OVERRIDE"
@ -74,6 +77,9 @@ getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR
getOverrideStatusR :: Handler () getOverrideStatusR :: Handler ()
getOverrideStatusR = invalidArgs ["OVERRIDE"] getOverrideStatusR = invalidArgs ["OVERRIDE"]
getBuilderR :: Handler TypedContent
getBuilderR = return $ TypedContent "ignored" $ ContentBuilder (error "builder-3.14159") Nothing
errorHandlingTest :: Spec errorHandlingTest :: Spec
errorHandlingTest = describe "Test.ErrorHandling" $ do errorHandlingTest = describe "Test.ErrorHandling" $ do
it "says not found" caseNotFound it "says not found" caseNotFound
@ -82,6 +88,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do
it "error in body == 500" caseErrorInBody it "error in body == 500" caseErrorInBody
it "error in body, no eval == 200" caseErrorInBodyNoEval it "error in body, no eval == 200" caseErrorInBodyNoEval
it "can override status code" caseOverrideStatus it "can override status code" caseOverrideStatus
it "builder" caseBuilder
runner :: Session () -> IO () runner :: Session () -> IO ()
runner f = toWaiApp App >>= runSession f runner f = toWaiApp App >>= runSession f
@ -140,3 +147,9 @@ caseOverrideStatus :: IO ()
caseOverrideStatus = runner $ do caseOverrideStatus = runner $ do
res <- request defaultRequest { pathInfo = ["override-status"] } res <- request defaultRequest { pathInfo = ["override-status"] }
assertStatus 15 res assertStatus 15 res
caseBuilder :: IO ()
caseBuilder = runner $ do
res <- request defaultRequest { pathInfo = ["builder"] }
assertStatus 500 res
assertBodyContains "builder-3.14159" res