Fix test suite

This commit is contained in:
Gregor Kleen 2017-10-04 14:48:23 +02:00
parent b86e60843f
commit fbc1ee52ca
2 changed files with 8 additions and 51 deletions

View File

@ -1,43 +0,0 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.CommentSpec (spec) where
import TestImport
import Data.Aeson
spec :: Spec
spec = withApp $ do
describe "valid request" $ do
it "gives a 200" $ do
get HomeR
statusIs 200
let message = "My message" :: Text
body = object [ "message" .= message ]
encoded = encode body
request $ do
setMethod "POST"
setUrl CommentR
setRequestBody encoded
addRequestHeader ("Content-Type", "application/json")
statusIs 200
[Entity _id comment] <- runDB $ selectList [CommentMessage ==. message] []
assertEq "Should have " comment (Comment message Nothing)
describe "invalid requests" $ do
it "400s when the JSON body is invalid" $ do
get HomeR
let body = object [ "foo" .= ("My message" :: Value) ]
request $ do
setMethod "POST"
setUrl CommentR
setRequestBody $ encode body
addRequestHeader ("Content-Type", "application/json")
statusIs 400

View File

@ -19,24 +19,24 @@ import Yesod.Auth as X
import Yesod.Test as X
import Yesod.Core.Unsafe (fakeHandlerGetLogger)
runDB :: SqlPersistM a -> YesodExample App a
runDB :: SqlPersistM a -> YesodExample UniWorX a
runDB query = do
app <- getTestYesod
liftIO $ runDBWithApp app query
runDBWithApp :: App -> SqlPersistM a -> IO a
runDBWithApp :: UniWorX -> SqlPersistM a -> IO a
runDBWithApp app query = runSqlPersistMPool query (appConnPool app)
runHandler :: Handler a -> YesodExample App a
runHandler :: Handler a -> YesodExample UniWorX a
runHandler handler = do
app <- getTestYesod
fakeHandlerGetLogger appLogger app handler
withApp :: SpecWith (TestApp App) -> Spec
withApp :: SpecWith (TestApp UniWorX) -> Spec
withApp = before $ do
settings <- loadYamlSettings
["config/test-settings.yml", "config/settings.yml"]
[".dbsettings.yml", "config/test-settings.yml", "config/settings.yml"]
[]
useEnv
foundation <- makeFoundation settings
@ -47,7 +47,7 @@ withApp = before $ do
-- This function will truncate all of the tables in your database.
-- 'withApp' calls it before each test, creating a clean environment for each
-- spec to run in.
wipeDB :: App -> IO ()
wipeDB :: UniWorX -> IO ()
wipeDB app = runDBWithApp app $ do
tables <- getTables
sqlBackend <- ask
@ -69,7 +69,7 @@ getTables = do
-- | Authenticate as a user. This relies on the `auth-dummy-login: true` flag
-- being set in test-settings.yaml, which enables dummy authentication in
-- Foundation.hs
authenticateAs :: Entity User -> YesodExample App ()
authenticateAs :: Entity User -> YesodExample UniWorX ()
authenticateAs (Entity _ u) = do
request $ do
setMethod "POST"
@ -78,7 +78,7 @@ authenticateAs (Entity _ u) = do
-- | Create a user. The dummy email entry helps to confirm that foreign-key
-- checking is switched off in wipeDB for those database backends which need it.
createUser :: Text -> YesodExample App (Entity User)
createUser :: Text -> YesodExample UniWorX (Entity User)
createUser ident = runDB $ do
user <- insertEntity User
{ userIdent = ident