Cache schema structure between tests for speed

Causes one test to fail
This commit is contained in:
Joe Nelson
2015-12-10 13:36:28 -08:00
parent a6512a2a69
commit b3144aee15
11 changed files with 101 additions and 34 deletions
+6 -2
View File
@@ -6,11 +6,15 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
-- }}}
spec :: Spec
spec = around (withApp cfgDefault)
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = around (withApp cfgDefault struct pool)
$ describe "authorization" $ do
it "hides tables that anonymous does not own" $
+6 -2
View File
@@ -6,13 +6,17 @@ import Test.Hspec.Wai
import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
import qualified Data.ByteString.Lazy as BL
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
import Network.HTTP.Types
-- }}}
spec :: Spec
spec = around (withApp cfgDefault) $ describe "CORS" $ do
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = around (withApp cfgDefault struct pool) $ describe "CORS" $ do
let preflightHeaders = [
("Accept", "*/*"),
("Origin", "http://example.com"),
+8 -3
View File
@@ -2,13 +2,18 @@ module Feature.DeleteSpec where
import Test.Hspec
import Test.Hspec.Wai
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
import Network.HTTP.Types
spec :: Spec
spec = beforeAll resetDb
. around (withApp cfgDefault) $
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = beforeAll resetDb
. around (withApp cfgDefault struct pool) $
describe "Deleting" $ do
context "existing record" $ do
it "succeeds with 204 and deletion count" $
+6 -2
View File
@@ -5,7 +5,11 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
import qualified Data.Aeson as JSON
import Data.Maybe (fromJust)
@@ -16,8 +20,8 @@ import Control.Monad (replicateM_)
import TestTypes(IncPK(..), CompoundPK(..))
spec :: Spec
spec = beforeAll_ resetDb $ around (withApp cfgDefault) $ do
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do
describe "Posting new record" $ do
after_ (clearTable "menagerie") . context "disparate csv types" $ do
it "accepts disparate json types" $ do
+8 -4
View File
@@ -6,12 +6,16 @@ import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
import SpecHelper
import Hasql as H
import Hasql.Postgres as P
spec :: Spec
spec =
import SpecHelper
import PostgREST.Types (DbStructure(..))
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool =
beforeAll resetDb
. around (withApp $ cfgLimitRows 3) $
. around (withApp (cfgLimitRows 3) struct pool) $
describe "Requesting many items with server limits enabled" $ do
it "restricts results" $
get "/items"
+6 -3
View File
@@ -6,12 +6,15 @@ import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders))
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
import Text.Heredoc
spec :: Spec
spec = around (withApp cfgDefault) $ do
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = around (withApp cfgDefault struct pool) $ do
describe "Querying a table with a column called count" $
it "should not confuse count column with pg_catalog.count aggregate" $
+8 -4
View File
@@ -6,11 +6,15 @@ import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
import SpecHelper
import Hasql as H
import Hasql.Postgres as P
spec :: Spec
spec = beforeAll resetDb
. around (withApp cfgDefault) $
import SpecHelper
import PostgREST.Types (DbStructure(..))
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = beforeAll resetDb
. around (withApp cfgDefault struct pool) $
describe "GET /items" $ do
context "without range headers" $ do
+6 -2
View File
@@ -4,12 +4,16 @@ import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Hasql as H
import Hasql.Postgres as P
import SpecHelper
import PostgREST.Types (DbStructure(..))
import Network.HTTP.Types
spec :: Spec
spec = around (withApp cfgDefault) $ do
spec :: DbStructure -> H.Pool P.Postgres -> Spec
spec struct pool = around (withApp cfgDefault struct pool) $ do
describe "GET /" $ do
it "lists views in schema" $
request methodGet "/" [] ""
+32 -2
View File
@@ -2,7 +2,37 @@ module Main where
import Test.Hspec
import SpecHelper
import Spec
import PostgREST.Types (DbStructure(..))
import qualified Feature.AuthSpec
import qualified Feature.CorsSpec
import qualified Feature.DeleteSpec
import qualified Feature.InsertSpec
import qualified Feature.QueryLimitedSpec
import qualified Feature.QuerySpec
import qualified Feature.RangeSpec
import qualified Feature.StructureSpec
main :: IO ()
main = setupDb >> hspec spec
main = do
setupDb
pool <- specDbPool
dbStructure <- specDbStructure pool
-- Not using hspec-discover because we want to precompute
-- the db structure and pass it to specs for speed
mapM_ (hspec . ($ pool) . ($ dbStructure)) specs
where
specs = [
Feature.AuthSpec.spec
, Feature.CorsSpec.spec
, Feature.DeleteSpec.spec
, Feature.InsertSpec.spec
, Feature.QueryLimitedSpec.spec
, Feature.QuerySpec.spec
, Feature.RangeSpec.spec
, Feature.StructureSpec.spec
]
-1
View File
@@ -1 +0,0 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+15 -9
View File
@@ -30,6 +30,7 @@ import PostgREST.Config (AppConfig(..))
import PostgREST.Middleware
import PostgREST.Error(pgErrResponse)
import PostgREST.DbStructure
import PostgREST.Types
dbString :: String
dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
@@ -49,20 +50,23 @@ testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
pgSettings :: P.Settings
pgSettings = P.StringSettings $ cs dbString
withApp :: AppConfig -> ActionWith Application -> IO ()
withApp config perform = do
pool :: H.Pool P.Postgres
<- H.acquirePool pgSettings testPoolOpts
specDbPool :: IO (H.Pool P.Postgres)
specDbPool = H.acquirePool pgSettings testPoolOpts
let txSettings = Just (H.ReadCommitted, Just True)
dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema config)
db <- either (fail . show) return dbOrError
specDbStructure :: H.Pool P.Postgres -> IO DbStructure
specDbStructure pool = do
dbOrError <- H.session pool $ H.tx specTxSettings
$ getDbStructure "postgrest_test"
either (fail . show) return dbOrError
withApp :: AppConfig -> DbStructure -> H.Pool P.Postgres
-> ActionWith Application -> IO ()
withApp config dbStructure pool perform = do
perform $ middle $ \req resp -> do
time <- getPOSIXTime
body <- strictRequestBody req
result <- liftIO $ H.session pool $ H.tx txSettings
$ runWithClaims config time (app db config body) req
result <- liftIO $ H.session pool $ H.tx specTxSettings
$ runWithClaims config time (app dbStructure config body) req
either (resp . pgErrResponse) resp result
where middle = defaultMiddle
@@ -111,3 +115,5 @@ clearTable table = do
pool <- testPool
void . liftIO $ H.session pool $ H.tx Nothing $
H.unitEx $ B.Stmt ("truncate table test." <> table <> " cascade") V.empty True
specTxSettings = Just (H.ReadCommitted, Just True)