Clean tests

package.yaml

@@ -87,18 +87,6 @@ executables:
     - condition: flag(library-only)
       buildable: false
 
-# Test suite
-tests:
-  wms-server-test:
-    main: Spec.hs
-    source-dirs: test
-    ghc-options: -Wall
-    dependencies:
-    - wms-server
-    - hspec >=2.0.0
-    - yesod-test
-    - microlens
-
 # Define flags used by "yesod devel" to make compilation faster
 flags:
   library-only:

test/Handler/CommentSpec.hs

-{-# 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
-
-            comments <- runDB $ selectList [CommentMessage ==. message] []
-            Entity _id comment <-
-                case comments of
-                    [ent] -> pure ent
-                    _ -> error "needed 1 entity"
-            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
-

test/Handler/CommonSpec.hs

-module Handler.CommonSpec (spec) where
-
-import TestImport
-
-spec :: Spec
-spec = withApp $ do
-    describe "robots.txt" $ do
-        it "gives a 200" $ do
-            get RobotsR
-            statusIs 200
-        it "has correct User-agent" $ do
-            get RobotsR
-            bodyContains "User-agent: *"
-    describe "favicon.ico" $ do
-        it "gives a 200" $ do
-            get FaviconR
-            statusIs 200

test/Handler/HomeSpec.hs

-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.HomeSpec (spec) where
-
-import TestImport
-
-spec :: Spec
-spec = withApp $ do
-
-    describe "Homepage" $ do
-        it "loads the index and checks it looks right" $ do
-          get HomeR
-          statusIs 200
-          htmlAnyContain "h1" "a modern framework for blazing fast websites"
-
-          request $ do
-              setMethod "POST"
-              setUrl HomeR
-              addToken
-              fileByLabelExact "Choose a file" "test/Spec.hs" "text/plain" -- talk about self-reference
-              byLabelExact "What's on the file?" "Some Content"
-
-          statusIs 200
-          -- more debugging printBody
-          htmlAllContain ".upload-response" "text/plain"
-          htmlAllContain ".upload-response" "Some Content"
-
-        -- This is a simple example of using a database access in a test.  The
-        -- test will succeed for a fresh scaffolded site with an empty database,
-        -- but will fail on an existing database with a non-empty user table.
-        it "leaves the user table empty" $ do
-          get HomeR
-          statusIs 200
-          users <- runDB $ selectList ([] :: [Filter User]) []
-          assertEq "user table empty" 0 $ length users

test/Handler/ProfileSpec.hs

-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Handler.ProfileSpec (spec) where
-
-import TestImport
-
-spec :: Spec
-spec = withApp $ do
-
-    describe "Profile page" $ do
-        it "asserts no access to my-account for anonymous users" $ do
-            get ProfileR
-            statusIs 403
-
-        it "asserts access to my-account for authenticated users" $ do
-            userEntity <- createUser "foo"
-            authenticateAs userEntity
-
-            get ProfileR
-            statusIs 200
-
-        it "asserts user's information is shown" $ do
-            userEntity <- createUser "bar"
-            authenticateAs userEntity
-
-            get ProfileR
-            let (Entity _ user) = userEntity
-            htmlAnyContain ".username" . unpack $ userIdent user

test/Spec.hs

-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

test/TestImport.hs

-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-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, rawSql, unSingle, connEscapeName)
-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)
-
--- Wiping the database
-import Database.Persist.Sqlite              (sqlDatabase, mkSqliteConnectionInfo, fkEnabled, createSqlitePoolFromInfo)
-import Control.Monad.Logger                 (runLoggingT)
-import Lens.Micro                           (set)
-import Settings (appDatabaseConf)
-import Yesod.Core (messageLoggerSource)
-
-runDB :: SqlPersistM a -> YesodExample App a
-runDB query = do
-    pool <- fmap appConnPool getTestYesod
-    liftIO $ runSqlPersistMPool query pool
-
-runHandler :: Handler a -> YesodExample App a
-runHandler handler = do
-    app <- getTestYesod
-    fakeHandlerGetLogger appLogger app handler
-
-withApp :: SpecWith (TestApp App) -> Spec
-withApp = before $ do
-    settings <- loadYamlSettings
-        ["config/test-settings.yml", "config/settings.yml"]
-        []
-        useEnv
-    foundation <- makeFoundation settings
-    wipeDB foundation
-    logWare <- liftIO $ makeLogWare foundation
-    return (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 :: App -> IO ()
-wipeDB app = do
-    -- In order to wipe the database, we need to use a connection which has
-    -- foreign key checks disabled.  Foreign key checks are enabled or disabled
-    -- per connection, so this won't effect queries outside this function.
-    --
-    -- Aside: foreign key checks are enabled by persistent-sqlite, as of
-    -- version 2.6.2, unless they are explicitly disabled in the
-    -- SqliteConnectionInfo.
-
-    let logFunc = messageLoggerSource app (appLogger app)
-
-    let dbName = sqlDatabase $ appDatabaseConf $ appSettings app
-        connInfo = set fkEnabled False $ mkSqliteConnectionInfo dbName
-
-    pool <- runLoggingT (createSqlitePoolFromInfo connInfo 1) logFunc
-
-    flip runSqlPersistMPool pool $ do
-        tables <- getTables
-        sqlBackend <- ask
-        let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables
-        forM_ queries (\q -> rawExecute q [])
-
-getTables :: DB [Text]
-getTables = do
-    tables <- rawSql "SELECT name FROM sqlite_master WHERE type = 'table';" []
-    return (fmap unSingle tables)
-
--- | 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 _ u) = do
-    request $ do
-        setMethod "POST"
-        addPostParam "ident" $ userIdent u
-        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 :: Text -> YesodExample App (Entity User)
-createUser ident = runDB $ do
-    user <- insertEntity User
-        { userIdent = ident
-        , userPassword = Nothing
-        }
-    _ <- insert Email
-        { emailEmail = ident
-        , emailUserId = Just $ entityKey user
-        , emailVerkey = Nothing
-        }
-    return user