Merge branch 'spec-cache-dbstructure'

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" $

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"),

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" $

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

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"

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" $
@@ -219,6 +222,11 @@ spec = around (withApp cfgDefault) $ do
       get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith`
         "[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]"
 
+    it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $
+      get "/articles?id=eq.1&select=id,articleStars{users{*}}" `shouldRespondWith`
+        [str|[{"id":1,"articlestars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+
+
   describe "Plurality singular" $ do
     it "will select an existing object" $
       request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] ""

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

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 "/" [] ""
@@ -208,16 +212,14 @@ spec = around (withApp cfgDefault) $ do
       }
       |]
 
-    it "includes foreign key data" $ do
-      pendingWith "have to resolve issue #107"
-
+    it "includes foreign key data" $
       request methodOptions "/has_fk" [] ""
         `shouldRespondWith` [json|
       {
         "pkey": ["id"],
         "columns":[
           {
-            "default": "nextval('\"1\".has_fk_id_seq'::regclass)",
+            "default": "nextval('test.has_fk_id_seq'::regclass)",
             "precision": 64,
             "updatable": true,
             "schema": "test",
@@ -239,7 +241,7 @@ spec = around (withApp cfgDefault) $ do
             "nullable": true,
             "position": 2,
             "enum": [],
-            "references": {"table": "auto_incrementing_pk", "column": "id"}
+            "references": {"schema":"test", "table": "auto_incrementing_pk", "column": "id"}
           }, {
             "default": null,
             "precision": null,
@@ -251,14 +253,13 @@ spec = around (withApp cfgDefault) $ do
             "nullable": true,
             "position": 3,
             "enum": [],
-            "references": {"table": "simple_pk", "column": "k"}
+            "references": {"schema":"test", "table": "simple_pk", "column": "k"}
           }
         ]
       }
       |]
 
-    it "includes all information on views for renamed columns, and raises relations to correct schema" $ do
-      pendingWith "have to resolve issue #107"
+    it "includes all information on views for renamed columns, and raises relations to correct schema" $
       request methodOptions "/articleStars" [] ""
         `shouldRespondWith` [json|
           {

test/Main.hs

@@ -2,7 +2,36 @@ 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
+  hspec $ specs dbStructure pool
+
+ where
+  specs dbStructure pool = do
+    describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure pool
+    describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure pool
+    describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure pool
+    describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure pool
+    describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure pool
+    describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure pool
+    describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure pool
+    describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure pool

test/Spec.hs

@@ -1 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

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 "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,6 @@ 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 :: Maybe (TxIsolationLevel, Maybe Bool)
+specTxSettings = Just (H.ReadCommitted, Just True)