s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

Bring back tests

Browse Source
This commit is contained in:
Filip Graliński 2018-09-20 13:02:07 +02:00
parent 5ade94b225
commit ef6e892680
5 changed files with 99 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Application.hs
View File

@ -5,6 +5,7 @@ module Application
, appSelfContainedMain
, develMain
, makeFoundation
, makeLogWare
-- * for DevelMain
, getApplicationRepl
, shutdownApp
@ -22,6 +23,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException,
runSettings, setHost,
setOnException, setPort, getPort)
import Network.Wai (Middleware)
import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..),
OutputFormat (..), destination,
@ -142,6 +144,19 @@ makeApplication foundation = do
appPlain <- toWaiAppPlain foundation
return $ logWare $ defaultMiddlewaresNoLogging appPlain
makeLogWare :: App -> IO Middleware
makeLogWare foundation =
mkRequestLogger def
{ outputFormat =
if appDetailedRequestLogging $ appSettings foundation
then Detailed True
else Apache
(if appIpFromHeader $ appSettings foundation
then FromFallback
else FromSocket)
, destination = Logger $ loggerSet $ appLogger foundation
}
-- | Warp settings for the given foundation value.
warpSettings :: App -> Settings
warpSettings foundation =

16
Foundation.hs
View File

@ -8,6 +8,8 @@ import Text.Hamlet (hamletFile)
import Yesod.Auth.HashDB (HashDBUser(..), authHashDBWithForm)
import qualified Yesod.Core.Unsafe as Unsafe
import Yesod.Core.Types (Logger)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
import Yesod.Default.Util (addStaticContentExternal)
instance HashDBUser User where
@ -49,6 +51,10 @@ mkMessage "App" "messages" "en"
-- | A convenient synonym for creating forms.
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
-- | A convenient synonym for database access functions.
type DB a = forall (m :: * -> *).
(MonadIO m) => ReaderT SqlBackend m a
isTrustedAuthorized :: (AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, MonadHandler m, YesodAuthPersist (HandlerSite m)) => m AuthResult
isTrustedAuthorized = do
mauth <- maybeAuth
@ -92,6 +98,16 @@ instance Yesod App where
120 -- timeout in minutes
((appVarDir $ appSettings app) </> "config/client_session_key.aes")
-- Yesod Middleware allows you to run code before and after each handler function.
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
-- Some users may also want to add the defaultCsrfMiddleware, which:
-- a) Sets a cookie with a CSRF token in it.
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
yesodMiddleware = defaultYesodMiddleware
defaultLayout widget = do
master <- getYesod
mmsg <- getMessage

6
gonito.cabal
View File

@ -89,6 +89,7 @@ library
, classy-prelude-conduit >= 0.10.2
, classy-prelude-yesod >= 0.10.2
, bytestring >= 0.9 && < 0.11
, case-insensitive
, text >= 0.11 && < 2.0
, persistent >= 2.0 && < 2.9
, persistent-postgresql >= 2.1.1 && < 2.9
@ -140,6 +141,7 @@ library
, extra
, attoparsec
, random-strings
, wai
executable gonito
if flag(library-only)
@ -187,8 +189,9 @@ test-suite test
build-depends: base
, gonito
, yesod-test >= 1.4.3 && < 1.5
, yesod-test >= 1.6 && < 1.7
, yesod-core
, yesod-auth >= 1.6 && < 1.7
, yesod
, persistent
, persistent-postgresql
@ -200,3 +203,4 @@ test-suite test
, classy-prelude
, classy-prelude-yesod
, wai-handler-fastcgi
, wai

39
test/Handler/HomeSpec.hs
View File

@ -1,32 +1,23 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.HomeSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
it "loads the index and checks it looks right" $ do
get HomeR
statusIs 200
htmlAllContain "h1" "Welcome to Yesod"
request $ do
setMethod "POST"
setUrl HomeR
addToken
fileByLabel "Choose a file" "test/Spec.hs" "text/plain" -- talk about self-reference
byLabel "What's on the file?" "Some Content"
describe "Homepage" $ do
it "loads the index and checks it looks right" $ do
get HomeR
statusIs 200
htmlAnyContain "h1" "Welcome to Gonito.net!"
statusIs 200
-- more debugging printBody
htmlCount ".message" 1
htmlAllContain ".message" "Some Content"
htmlAllContain ".message" "text/plain"
-- 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]) []
assertEqual "user table empty" 0 $ length users
-- 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

57
test/TestImport.hs
View File

@ -1,18 +1,23 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module TestImport
( module TestImport
, module X
) where
import Application (makeFoundation)
import ClassyPrelude as X
import Application (makeFoundation, makeLogWare)
import ClassyPrelude as X hiding (delete, deleteBy, Handler)
import Database.Persist as X hiding (get)
import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
import Foundation as X
import Model as X
import Test.Hspec as X
import Text.Shakespeare.Text (st)
import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
import Yesod.Default.Config2 (useEnv, loadYamlSettings)
import Yesod.Auth as X
import Yesod.Test as X
import Yesod.Core.Unsafe (fakeHandlerGetLogger)
runDB :: SqlPersistM a -> YesodExample App a
runDB query = do
@ -22,16 +27,22 @@ runDB query = do
runDBWithApp :: App -> SqlPersistM a -> IO a
runDBWithApp app query = runSqlPersistMPool query (appConnPool app)
runHandler :: Handler a -> YesodExample App a
runHandler handler = do
app <- getTestYesod
fakeHandlerGetLogger appLogger app handler
withApp :: SpecWith App -> Spec
withApp :: SpecWith (TestApp App) -> Spec
withApp = before $ do
settings <- loadAppSettings
settings <- loadYamlSettings
["config/test-settings.yml", "config/settings.yml"]
[]
ignoreEnv
useEnv
foundation <- makeFoundation settings
wipeDB foundation
return 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
@ -45,7 +56,7 @@ wipeDB app = runDBWithApp app $ do
query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables
rawExecute query []
getTables :: MonadIO m => ReaderT SqlBackend m [Text]
getTables :: DB [Text]
getTables = do
tables <- rawSql [st|
SELECT table_name
@ -54,3 +65,31 @@ getTables = do
|] []
return $ map 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
, userName = Nothing
, userIsAdmin = False
, userLocalId = Nothing
, userIsAnonymous = False
, userAvatar = Nothing
, userVerificationKey = Nothing
, userKeyExpirationDate = Nothing
, userTriggerToken = Nothing
}
return user