Add persistent storage tests to using SQLite and PostgreSQL.
Currently failing tests: 1) SqlStorage on PostgreSQL insertSession throws an exception if a session already exists 2) SqlStorage on PostgreSQL replaceSession throws an exception if a session does not exist 3) SqlStorage on SQLite insertSession throws an exception if a session already exists 4) SqlStorage on SQLite replaceSession throws an exception if a session does not exist
This commit is contained in:
parent
b19ddd1922
commit
8a6df8cc6c
1
.gitignore
vendored
1
.gitignore
vendored
@ -11,3 +11,4 @@ cabal.sandbox.config
|
|||||||
/vendor/
|
/vendor/
|
||||||
.shelly/
|
.shelly/
|
||||||
tarballs/
|
tarballs/
|
||||||
|
\#*#
|
||||||
|
|||||||
1
serversession-backend-persistent/.gitignore
vendored
Normal file
1
serversession-backend-persistent/.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
test.db*
|
||||||
@ -45,6 +45,31 @@ library
|
|||||||
TypeFamilies
|
TypeFamilies
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
||||||
|
|
||||||
|
test-suite tests
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
hs-source-dirs: tests
|
||||||
|
build-depends:
|
||||||
|
|
||||||
|
base, aeson, base64-bytestring, bytestring, containers,
|
||||||
|
path-pieces, persistent, persistent-template, text, time
|
||||||
|
|
||||||
|
, hspec >= 2.1 && < 3
|
||||||
|
, monad-logger
|
||||||
|
, persistent-sqlite == 2.1.*
|
||||||
|
, persistent-postgresql == 2.1.*
|
||||||
|
, resource-pool
|
||||||
|
, QuickCheck
|
||||||
|
|
||||||
|
, serversession
|
||||||
|
, serversession-backend-persistent
|
||||||
|
extensions:
|
||||||
|
OverloadedStrings
|
||||||
|
TemplateHaskell
|
||||||
|
main-is: Main.hs
|
||||||
|
ghc-options: -Wall -threaded -with-rtsopts=-N
|
||||||
|
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/yesodweb/serversession
|
location: https://github.com/yesodweb/serversession
|
||||||
|
|||||||
35
serversession-backend-persistent/tests/Main.hs
Normal file
35
serversession-backend-persistent/tests/Main.hs
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Control.Monad (forM_)
|
||||||
|
import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
|
||||||
|
import Data.Pool (destroyAllResources)
|
||||||
|
import Database.Persist.Postgresql (createPostgresqlPool)
|
||||||
|
import Database.Persist.Sqlite (createSqlitePool)
|
||||||
|
import Test.Hspec
|
||||||
|
import Web.ServerSession.Backend.Persistent
|
||||||
|
import Web.ServerSession.Core.StorageTests
|
||||||
|
|
||||||
|
import qualified Control.Exception as E
|
||||||
|
import qualified Database.Persist.TH as P
|
||||||
|
import qualified Database.Persist.Sql as P
|
||||||
|
|
||||||
|
P.mkMigrate "migrateAll" serverSessionDefs
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = hspec $ parallel $
|
||||||
|
forM_ [ ("PostgreSQL", createPostgresqlPool "host=localhost user=test dbname=test password=test" 20)
|
||||||
|
, ("SQLite", createSqlitePool "test.db" 1) ] $
|
||||||
|
\(rdbms, createPool) ->
|
||||||
|
describe ("SqlStorage on " ++ rdbms) $ do
|
||||||
|
epool <-
|
||||||
|
runIO $ E.try $ do
|
||||||
|
pool <- runNoLoggingT createPool
|
||||||
|
runStderrLoggingT $ P.runSqlPool (P.runMigration migrateAll) pool
|
||||||
|
return pool
|
||||||
|
case epool of
|
||||||
|
Left (E.SomeException exc) ->
|
||||||
|
it "failed to create connection or migrate database" $
|
||||||
|
pendingWith (show exc)
|
||||||
|
Right pool ->
|
||||||
|
afterAll_ (destroyAllResources pool) $
|
||||||
|
parallel $ allStorageTests (SqlStorage pool) it runIO shouldBe shouldReturn shouldThrow
|
||||||
Loading…
Reference in New Issue
Block a user