ErrorHandlingBug (from Aur)
This commit is contained in:
parent
e5426f8696
commit
35274e4859
98
yesod-core/test/Test/ErrorHandling.hs
Normal file
98
yesod-core/test/Test/ErrorHandling.hs
Normal file
@ -0,0 +1,98 @@
|
||||
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
|
||||
module Test.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 where approot _ = ""
|
||||
|
||||
getHomeR :: Handler RepHtml
|
||||
getHomeR = defaultLayout $ toWidget [hamlet|
|
||||
!!!
|
||||
|
||||
<html>
|
||||
<body>
|
||||
<form method=post action=@{NotFoundR}>
|
||||
<input type=submit value="Not found">
|
||||
<form method=post action=@{FirstThingR}>
|
||||
<input type=submit value="Error is thrown first thing in handler">
|
||||
<form method=post action=@{AfterRunRequestBodyR}>
|
||||
<input type=submit value="BUGGY: Error thrown after runRequestBody">
|
||||
|]
|
||||
|
||||
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 "There was an error 2.71828" res
|
||||
@ -7,6 +7,7 @@ import Test.Media
|
||||
import Test.Links
|
||||
import Test.NoOverloadedStrings
|
||||
import Test.InternalRequest
|
||||
import Test.ErrorHandling
|
||||
|
||||
main :: IO ()
|
||||
main = hspecX $ descriptions $
|
||||
@ -17,4 +18,5 @@ main = hspecX $ descriptions $
|
||||
, linksTest
|
||||
, noOverloadedTest
|
||||
, internalRequestTest
|
||||
, errorHandlingTest
|
||||
]
|
||||
|
||||
@ -23,6 +23,7 @@ extra-source-files:
|
||||
test/Test/CleanPath.hs
|
||||
test/Test/Links.hs
|
||||
test/Test/InternalRequest.hs
|
||||
test/Test/ErrorHandling.hs
|
||||
test/main.hs
|
||||
|
||||
flag test
|
||||
@ -107,8 +108,8 @@ test-suite runtests
|
||||
build-depends: base >= 4 && < 4.3
|
||||
main-is: main.hs
|
||||
cpp-options: -DTEST
|
||||
build-depends: hspec >= 0.8 && < 0.9
|
||||
,wai-test
|
||||
build-depends: hspec >= 0.8 && < 0.10
|
||||
,wai-test >= 0.1.2 && < 0.2
|
||||
,wai
|
||||
,yesod-core
|
||||
,bytestring
|
||||
|
||||
Loading…
Reference in New Issue
Block a user