It all compiles but all requests give a postgres error

This commit is contained in:
Joe Nelson
2016-01-24 18:09:19 -08:00
parent fec316b087
commit b9fd083c77
10 changed files with 43 additions and 47 deletions
+2 -3
View File
@@ -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" $
+2 -3
View File
@@ -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"),
+3 -4
View File
@@ -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" $
+2 -3
View File
@@ -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
+3 -4
View File
@@ -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"
+2 -3
View File
@@ -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" $
+3 -4
View File
@@ -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
+2 -3
View File
@@ -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
View File
@@ -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
View File
@@ -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