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