diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 0bb294fb..1506c9c1 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -15,6 +15,9 @@ import Control.Exception (SomeException, try) import Network.HTTP.Types (mkStatus) import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString) import Data.Monoid (mconcat) +import Data.Text (Text, pack) +import Control.Monad (forM_) +import qualified Control.Exception.Lifted as E data App = App @@ -26,6 +29,7 @@ mkYesod "App" [parseRoutes| /error-in-body ErrorInBodyR GET /error-in-body-noeval ErrorInBodyNoEvalR GET /override-status OverrideStatusR GET +/error/#Int ErrorR GET -- https://github.com/yesodweb/yesod/issues/658 /builder BuilderR GET @@ -98,6 +102,18 @@ goodBuilderContent = mconcat $ replicate 100 $ fromByteString "This is a test\n" getGoodBuilderR :: Handler TypedContent getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent +getErrorR :: Int -> Handler () +getErrorR 1 = setSession undefined "foo" +getErrorR 2 = setSession "foo" undefined +getErrorR 3 = deleteSession undefined +getErrorR 4 = addHeader undefined "foo" +getErrorR 5 = addHeader "foo" undefined +getErrorR 6 = expiresAt undefined +getErrorR 7 = setLanguage undefined +getErrorR 8 = cacheSeconds undefined +getErrorR 9 = setUltDest (undefined :: Text) +getErrorR 10 = setMessage undefined + errorHandlingTest :: Spec errorHandlingTest = describe "Test.ErrorHandling" $ do it "says not found" caseNotFound @@ -110,6 +126,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do it "file with bad len" caseFileBadLen it "file with bad name" caseFileBadName it "builder includes content-length" caseGoodBuilder + forM_ [1..10] $ \i -> it ("error case " ++ show i) (caseError i) runner :: Session () -> IO () runner f = toWaiApp App >>= runSession f @@ -194,3 +211,10 @@ caseGoodBuilder = runner $ do let lbs = toLazyByteString goodBuilderContent assertBody lbs res assertHeader "content-length" (S8.pack $ show $ L.length lbs) res + +caseError :: Int -> IO () +caseError i = runner $ do + res <- request defaultRequest { pathInfo = ["error", pack $ show i] } + assertStatus 500 res `E.catch` \e -> do + liftIO $ print res + E.throwIO (e :: E.SomeException)