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