diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 583e569b1..35595153d 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -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" $ diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index 1e0da8695..8bc7f600c 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -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"), diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index 263f1f0af..c0f252728 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -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" $ diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index a8bfbc4c6..3a67b8163 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -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 diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs index 7545282ee..aad13bb3f 100644 --- a/test/Feature/QueryLimitedSpec.hs +++ b/test/Feature/QueryLimitedSpec.hs @@ -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" diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 45803c81e..ee318c3f8 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -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" $ diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs index 0e7d519f6..a8e276272 100644 --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -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 diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 253672e98..034081cb1 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -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 "/" [] "" diff --git a/test/Main.hs b/test/Main.hs index 2a8006727..feda68594 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -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 + ] diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 index b4e92e756..000000000 --- a/test/Spec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-} diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index a63340145..f214582eb 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -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)