Minor test cleanup
This commit is contained in:
parent
48f56a5fe3
commit
447e30b1d9
13
test.sh
13
test.sh
@ -1,14 +1,3 @@
|
|||||||
#!/usr/bin/env bash
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
move-back() {
|
exec -- stack build --test --fast --flag uniworx:dev --flag uniworx:library-only ${@}
|
||||||
mv -v .stack-work .stack-work-test
|
|
||||||
[[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work
|
|
||||||
}
|
|
||||||
|
|
||||||
if [[ -d .stack-work-test ]]; then
|
|
||||||
[[ -d .stack-work ]] && mv -v .stack-work .stack-work-build
|
|
||||||
mv -v .stack-work-test .stack-work
|
|
||||||
trap move-back EXIT
|
|
||||||
fi
|
|
||||||
|
|
||||||
stack build --test --fast --flag uniworx:dev --flag uniworx:library-only ${@}
|
|
||||||
|
|||||||
@ -22,14 +22,14 @@ spec = withApp $ do
|
|||||||
statusIs 200
|
statusIs 200
|
||||||
|
|
||||||
it "asserts access to my-account for authenticated users" $ do
|
it "asserts access to my-account for authenticated users" $ do
|
||||||
userEntity <- createUser "foo"
|
userEntity <- createUser id
|
||||||
authenticateAs userEntity
|
authenticateAs userEntity
|
||||||
|
|
||||||
get ProfileR
|
get ProfileR
|
||||||
statusIs 200
|
statusIs 200
|
||||||
|
|
||||||
it "displays basic user data" $ do
|
it "displays basic user data" $ do
|
||||||
userEntity@(Entity _userId User{..}) <- createUser "foo"
|
userEntity@(Entity _userId User{..}) <- createUser id
|
||||||
authenticateAs userEntity
|
authenticateAs userEntity
|
||||||
|
|
||||||
get ProfileDataR
|
get ProfileDataR
|
||||||
|
|||||||
@ -4,7 +4,7 @@ module TestImport
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Application (makeFoundation, makeLogWare)
|
import Application (makeFoundation, makeLogWare)
|
||||||
import ClassyPrelude as X hiding (delete, deleteBy, Handler)
|
import ClassyPrelude as X hiding (delete, deleteBy, Handler, Index, (<.>), (<|), index, uncons, unsnoc, cons, snoc)
|
||||||
import Database.Persist as X hiding (get)
|
import Database.Persist as X hiding (get)
|
||||||
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool)
|
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool)
|
||||||
import Foundation as X
|
import Foundation as X
|
||||||
@ -31,6 +31,8 @@ import Data.UUID as X (UUID)
|
|||||||
import System.IO as X (hPrint, hPutStrLn, stderr)
|
import System.IO as X (hPrint, hPutStrLn, stderr)
|
||||||
import Jobs (handleJobs, stopJobCtl)
|
import Jobs (handleJobs, stopJobCtl)
|
||||||
|
|
||||||
|
import Control.Lens as X hiding ((<.), elements)
|
||||||
|
|
||||||
import Database (truncateDb)
|
import Database (truncateDb)
|
||||||
import Database as X (fillDb)
|
import Database as X (fillDb)
|
||||||
|
|
||||||
@ -99,12 +101,13 @@ authenticateAs (Entity _ User{..}) = 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 :: CI Text -> YesodExample UniWorX (Entity User)
|
createUser :: (User -> User) -> YesodExample UniWorX (Entity User)
|
||||||
createUser userIdent = do
|
createUser adjUser = do
|
||||||
UserDefaultConf{..} <- appUserDefaults . appSettings <$> getTestYesod
|
UserDefaultConf{..} <- appUserDefaults . appSettings <$> getTestYesod
|
||||||
let
|
let
|
||||||
userMatrikelnummer = Nothing
|
userMatrikelnummer = Nothing
|
||||||
userAuthentication = AuthLDAP
|
userAuthentication = AuthLDAP
|
||||||
|
userIdent = "dummy@example.invalid"
|
||||||
userEmail = "dummy@example.invalid"
|
userEmail = "dummy@example.invalid"
|
||||||
userDisplayName = "Dummy Example"
|
userDisplayName = "Dummy Example"
|
||||||
userSurname = "Example"
|
userSurname = "Example"
|
||||||
@ -116,7 +119,7 @@ createUser userIdent = do
|
|||||||
userDownloadFiles = userDefaultDownloadFiles
|
userDownloadFiles = userDefaultDownloadFiles
|
||||||
userMailLanguages = def
|
userMailLanguages = def
|
||||||
userNotificationSettings = def
|
userNotificationSettings = def
|
||||||
runDB $ insertEntity User{..}
|
runDB . insertEntity $ adjUser User{..}
|
||||||
|
|
||||||
lawsCheckHspec :: Typeable a => Proxy a -> [Proxy a -> Laws] -> Spec
|
lawsCheckHspec :: Typeable a => Proxy a -> [Proxy a -> Laws] -> Spec
|
||||||
lawsCheckHspec p = describe (show $ typeRep p) . mapM_ (checkHspec . ($ p))
|
lawsCheckHspec p = describe (show $ typeRep p) . mapM_ (checkHspec . ($ p))
|
||||||
|
|||||||
Reference in New Issue
Block a user