Test cases for #712

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)