module TestImport ( module TestImport , module X ) where import Application (makeFoundation, makeLogWare) import ClassyPrelude as X hiding (delete, deleteBy, Handler) import Database.Persist as X hiding (get) import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool, rawExecute, unSingle, connEscapeName, sqlQQ) import Foundation as X import Model as X import Test.Hspec as X import Yesod.Default.Config2 (useEnv, loadYamlSettings) import Yesod.Auth as X import Yesod.Test as X import Yesod.Core.Unsafe (fakeHandlerGetLogger) import Test.QuickCheck as X import Test.QuickCheck.Gen as X import Data.Default as X import Test.QuickCheck.Instances as X () import System.IO as X (hPrint, hPutStrLn, stderr) import Jobs (handleJobs, stopJobCtl) import Control.Monad.Trans.Resource (runResourceT, MonadResourceBase) import Data.Pool (destroyAllResources) import Settings import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI runDB :: SqlPersistM a -> YesodExample UniWorX a runDB query = do app <- getTestYesod liftIO $ runDBWithApp app query runDBWithApp :: MonadIO m => UniWorX -> SqlPersistM a -> m a runDBWithApp app query = liftIO $ runSqlPersistMPool query (appConnPool app) runHandler :: Handler a -> YesodExample UniWorX a runHandler handler = do app <- getTestYesod fakeHandlerGetLogger appLogger app handler withApp :: YSpec UniWorX -> Spec withApp = around $ \act -> runResourceT $ do settings <- liftIO $ loadYamlSettings ["config/test-settings.yml", "config/settings.yml"] [] useEnv foundation <- makeFoundation settings let stopDBAccess = do stopJobCtl foundation liftIO . destroyAllResources $ appConnPool foundation bracket_ stopDBAccess (handleJobs foundation) $ wipeDB foundation logWare <- makeLogWare foundation lift $ act (foundation, logWare) -- 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 :: (MonadResourceBase m, MonadMask m) => UniWorX -> m () wipeDB app = runDBWithApp app $ do tables <- map unSingle <$> [sqlQQ|SELECT table_name FROM information_schema.tables WHERE table_schema = 'public'|] sqlBackend <- ask let escapedTables = map (connEscapeName sqlBackend . DBName) $ filter (not . (`elem` protected)) tables query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables ++ " RESTART IDENTITY" protected = ["applied_migration"] rawExecute query [] -- | 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 UniWorX () authenticateAs (Entity _ User{..}) = do request $ do setMethod "GET" addRequestHeader ("Accept-Language", "de") setUrl $ AuthR LoginR request $ do setMethod "POST" addToken_ "#login--dummy" byLabelExact "Nutzer-Kennung" $ CI.original userIdent setUrl $ AuthR $ PluginR "dummy" [] -- | 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 UserDefaultConf{..} <- appUserDefaults . appSettings <$> getTestYesod let userMatrikelnummer = Nothing userAuthentication = AuthLDAP userEmail = "dummy@example.invalid" userDisplayName = "Dummy Example" userSurname = "Example" userTheme = userDefaultTheme userMaxFavourites = userDefaultMaxFavourites userDateTimeFormat = userDefaultDateTimeFormat userDateFormat = userDefaultDateFormat userTimeFormat = userDefaultTimeFormat userDownloadFiles = userDefaultDownloadFiles userMailLanguages = def userNotificationSettings = def runDB $ insertEntity User{..}