{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} module YesodCoreTest.ErrorHandling ( errorHandlingTest , Widget ) where import Yesod.Core import Test.Hspec import Test.Hspec.HUnit() import Network.Wai import Network.Wai.Test import Text.Hamlet (hamlet) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 data App = App mkYesod "App" [parseRoutes| / HomeR GET /not_found NotFoundR POST /first_thing FirstThingR POST /after_runRequestBody AfterRunRequestBodyR POST |] instance Yesod App getHomeR :: Handler RepHtml getHomeR = defaultLayout $ toWidget [hamlet| $doctype 5
|] postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml postNotFoundR = do (_, _files) <- runRequestBody _ <- notFound getHomeR postFirstThingR = do _ <- error "There was an error 3.14159" getHomeR postAfterRunRequestBodyR = do x <- runRequestBody _ <- error $ show x getHomeR errorHandlingTest :: [Spec] errorHandlingTest = describe "Test.ErrorHandling" [ it "says not found" caseNotFound , it "says 'There was an error' before runRequestBody" caseBefore , it "says 'There was an error' after runRequestBody" caseAfter ] runner :: Session () -> IO () runner f = toWaiApp App >>= runSession f caseNotFound :: IO () caseNotFound = runner $ do res <- request defaultRequest { pathInfo = ["not_found"] , requestMethod = "POST" } assertStatus 404 res assertBodyContains "Not Found" res caseBefore :: IO () caseBefore = runner $ do res <- request defaultRequest { pathInfo = ["first_thing"] , requestMethod = "POST" } assertStatus 500 res assertBodyContains "There was an error 3.14159" res caseAfter :: IO () caseAfter = runner $ do let content = "foo=bar&baz=bin12345" res <- srequest SRequest { simpleRequest = defaultRequest { pathInfo = ["after_runRequestBody"] , requestMethod = "POST" , requestHeaders = [ ("content-type", "application/x-www-form-urlencoded") , ("content-length", S8.pack $ show $ L.length content) ] } , simpleRequestBody = content } assertStatus 500 res assertBodyContains "bin12345" res