Fix test suite
This commit is contained in:
parent
b86e60843f
commit
fbc1ee52ca
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user