From b9fd083c772831106f82c055832cc70f15e2ffbd Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Thu, 21 Jan 2016 15:55:57 -0800 Subject: [PATCH] It all compiles but all requests give a postgres error --- test/Feature/AuthSpec.hs | 5 ++--- test/Feature/CorsSpec.hs | 5 ++--- test/Feature/DeleteSpec.hs | 7 +++---- test/Feature/InsertSpec.hs | 5 ++--- test/Feature/QueryLimitedSpec.hs | 7 +++---- test/Feature/QuerySpec.hs | 5 ++--- test/Feature/RangeSpec.hs | 7 +++---- test/Feature/StructureSpec.hs | 5 ++--- test/Main.hs | 35 ++++++++++++++++++-------------- test/SpecHelper.hs | 9 ++++---- 10 files changed, 43 insertions(+), 47 deletions(-) diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index fe77fb329..f678ae269 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -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" $ diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index a59e71b6e..811af712a 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -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"), diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index 8f9f9761f..ba9c60eea 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -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" $ diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 4a8478daf..54eb3be79 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -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 diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs index 50c404fb1..71e6aa714 100644 --- a/test/Feature/QueryLimitedSpec.hs +++ b/test/Feature/QueryLimitedSpec.hs @@ -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" diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 2e8e72b50..4de2b6061 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -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" $ diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs index c75cd4762..0ab998712 100644 --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -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 diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 5e7054f31..6fe0a80e4 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -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 "/" [] "" diff --git a/test/Main.hs b/test/Main.hs index 234713bd0..19fff8523 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -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 diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index cbaaeb1a2..11dd12d2a 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -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