It all compiles but all requests give a postgres error
This commit is contained in:
@@ -1,7 +1,6 @@
|
||||
module Feature.AuthSpec where
|
||||
|
||||
-- {{{ Imports
|
||||
import Data.Pool
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
@@ -12,8 +11,8 @@ import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
-- }}}
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = around (withApp cfgDefault struct pool)
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c)
|
||||
$ describe "authorization" $ do
|
||||
|
||||
it "hides tables that anonymous does not own" $
|
||||
|
||||
@@ -1,7 +1,6 @@
|
||||
module Feature.CorsSpec where
|
||||
|
||||
-- {{{ Imports
|
||||
import Data.Pool
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
|
||||
@@ -14,8 +13,8 @@ import PostgREST.Types (DbStructure(..))
|
||||
import Network.HTTP.Types
|
||||
-- }}}
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = around (withApp cfgDefault struct pool) $ describe "CORS" $ do
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do
|
||||
let preflightHeaders = [
|
||||
("Accept", "*/*"),
|
||||
("Origin", "http://example.com"),
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Feature.DeleteSpec where
|
||||
|
||||
import Data.Pool
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Text.Heredoc
|
||||
@@ -11,9 +10,9 @@ import qualified Hasql.Connection as H
|
||||
|
||||
import Network.HTTP.Types
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = beforeAll resetDb
|
||||
. around (withApp cfgDefault struct pool) $
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = beforeAll resetDb
|
||||
. around (withApp cfgDefault struct c) $
|
||||
describe "Deleting" $ do
|
||||
context "existing record" $ do
|
||||
it "succeeds with 204 and deletion count" $
|
||||
|
||||
@@ -10,7 +10,6 @@ import PostgREST.Types (DbStructure(..))
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Pool
|
||||
import Text.Heredoc
|
||||
import Network.HTTP.Types.Header
|
||||
import Network.HTTP.Types
|
||||
@@ -19,8 +18,8 @@ import qualified Hasql.Connection as H
|
||||
|
||||
import TestTypes(IncPK(..), CompoundPK(..))
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
|
||||
describe "Posting new record" $ do
|
||||
context "disparate csv types" $ do
|
||||
it "accepts disparate json types" $ do
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Feature.QueryLimitedSpec where
|
||||
|
||||
import Data.Pool
|
||||
import Test.Hspec hiding (pendingWith)
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
@@ -11,10 +10,10 @@ import qualified Hasql.Connection as H
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool =
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c =
|
||||
beforeAll resetDb
|
||||
. around (withApp (cfgLimitRows 3) struct pool) $
|
||||
. around (withApp (cfgLimitRows 3) struct c) $
|
||||
describe "Requesting many items with server limits enabled" $ do
|
||||
it "restricts results" $
|
||||
get "/items"
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Feature.QuerySpec where
|
||||
|
||||
import Data.Pool
|
||||
import Test.Hspec hiding (pendingWith)
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
@@ -12,8 +11,8 @@ import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
import Text.Heredoc
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = around (withApp cfgDefault struct pool) $ do
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $ do
|
||||
|
||||
describe "Querying a table with a column called count" $
|
||||
it "should not confuse count column with pg_catalog.count aggregate" $
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Feature.RangeSpec where
|
||||
|
||||
import Data.Pool
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
@@ -11,9 +10,9 @@ import qualified Hasql.Connection as H
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = beforeAll resetDb
|
||||
. around (withApp cfgDefault struct pool) $
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = beforeAll resetDb
|
||||
. around (withApp cfgDefault struct c) $
|
||||
describe "GET /items" $ do
|
||||
|
||||
context "without range headers" $ do
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
module Feature.StructureSpec where
|
||||
|
||||
import Data.Pool
|
||||
import Test.Hspec hiding (pendingWith)
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
@@ -11,8 +10,8 @@ import PostgREST.Types (DbStructure(..))
|
||||
|
||||
import Network.HTTP.Types
|
||||
|
||||
spec :: DbStructure -> Pool H.Connection -> Spec
|
||||
spec struct pool = around (withApp cfgDefault struct pool) $ do
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $ do
|
||||
describe "GET /" $ do
|
||||
it "lists views in schema" $
|
||||
request methodGet "/" [] ""
|
||||
|
||||
+20
-15
@@ -3,7 +3,10 @@ module Main where
|
||||
import Test.Hspec
|
||||
import SpecHelper
|
||||
|
||||
--import PostgREST.Types (DbStructure(..))
|
||||
import Data.Pool
|
||||
import qualified Hasql.Session as H
|
||||
|
||||
import PostgREST.DbStructure (getDbStructure)
|
||||
|
||||
import qualified Feature.AuthSpec
|
||||
import qualified Feature.CorsSpec
|
||||
@@ -19,19 +22,21 @@ main = do
|
||||
setupDb
|
||||
|
||||
pool <- testPool
|
||||
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
|
||||
withResource pool $ \case
|
||||
Left err -> error $ show err
|
||||
Right c -> do
|
||||
dbOrErr <- H.run (getDbStructure "test") c
|
||||
-- Not using hspec-discover because we want to precompute
|
||||
-- the db structure and pass it to specs for speed
|
||||
either (error.show) (hspec . specs c) dbOrErr
|
||||
|
||||
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
|
||||
specs conn dbStructure = do
|
||||
describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn
|
||||
describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure conn
|
||||
describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure conn
|
||||
describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure conn
|
||||
describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure conn
|
||||
describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure conn
|
||||
describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure conn
|
||||
describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure conn
|
||||
|
||||
+4
-5
@@ -38,17 +38,16 @@ cfgDefault = cfg dbString Nothing
|
||||
cfgLimitRows :: Integer -> AppConfig
|
||||
cfgLimitRows = cfg dbString . Just
|
||||
|
||||
withApp :: AppConfig -> DbStructure -> Pool H.Connection
|
||||
withApp :: AppConfig -> DbStructure -> H.Connection
|
||||
-> ActionWith Application -> IO ()
|
||||
withApp config dbStructure pool perform = do
|
||||
withApp config dbStructure c perform = do
|
||||
perform $ defaultMiddle $ \req resp -> do
|
||||
time <- getPOSIXTime
|
||||
body <- strictRequestBody req
|
||||
let handleReq = H.run (runWithClaims config time (app dbStructure config body) req)
|
||||
|
||||
withResource pool $ \c -> do
|
||||
resOrError <- handleReq c
|
||||
either (resp . pgErrResponse) resp resOrError
|
||||
resOrError <- handleReq c
|
||||
either (resp . pgErrResponse) resp resOrError
|
||||
|
||||
setupDb :: IO ()
|
||||
setupDb = do
|
||||
|
||||
Reference in New Issue
Block a user