diff --git a/test.sh b/test.sh index dd625c99c..09d4b3a53 100755 --- a/test.sh +++ b/test.sh @@ -1,14 +1,3 @@ #!/usr/bin/env bash -move-back() { - 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 ${@} +exec -- stack build --test --fast --flag uniworx:dev --flag uniworx:library-only ${@} diff --git a/test/Handler/ProfileSpec.hs b/test/Handler/ProfileSpec.hs index 5d34a831d..da8609703 100644 --- a/test/Handler/ProfileSpec.hs +++ b/test/Handler/ProfileSpec.hs @@ -22,14 +22,14 @@ spec = withApp $ do statusIs 200 it "asserts access to my-account for authenticated users" $ do - userEntity <- createUser "foo" + userEntity <- createUser id authenticateAs userEntity get ProfileR statusIs 200 it "displays basic user data" $ do - userEntity@(Entity _userId User{..}) <- createUser "foo" + userEntity@(Entity _userId User{..}) <- createUser id authenticateAs userEntity get ProfileDataR diff --git a/test/TestImport.hs b/test/TestImport.hs index 641893b40..344021b64 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -4,7 +4,7 @@ module TestImport ) where 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.Sql (SqlPersistM, runSqlPersistMPool) import Foundation as X @@ -31,6 +31,8 @@ import Data.UUID as X (UUID) import System.IO as X (hPrint, hPutStrLn, stderr) import Jobs (handleJobs, stopJobCtl) +import Control.Lens as X hiding ((<.), elements) + import Database (truncateDb) 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 -- checking is switched off in wipeDB for those database backends which need it. -createUser :: CI Text -> YesodExample UniWorX (Entity User) -createUser userIdent = do +createUser :: (User -> User) -> YesodExample UniWorX (Entity User) +createUser adjUser = do UserDefaultConf{..} <- appUserDefaults . appSettings <$> getTestYesod let userMatrikelnummer = Nothing userAuthentication = AuthLDAP + userIdent = "dummy@example.invalid" userEmail = "dummy@example.invalid" userDisplayName = "Dummy Example" userSurname = "Example" @@ -116,7 +119,7 @@ createUser userIdent = do userDownloadFiles = userDefaultDownloadFiles userMailLanguages = def userNotificationSettings = def - runDB $ insertEntity User{..} + runDB . insertEntity $ adjUser User{..} lawsCheckHspec :: Typeable a => Proxy a -> [Proxy a -> Laws] -> Spec lawsCheckHspec p = describe (show $ typeRep p) . mapM_ (checkHspec . ($ p))