diff --git a/postgrest.cabal b/postgrest.cabal index 09c6a9450..89d831cb4 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -134,7 +134,7 @@ library Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 - default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes + default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase Hs-Source-Dirs: test, src if flag(ci) ghc-options: -Wall -W -Werror @@ -185,6 +185,7 @@ Test-Suite spec , parsec , process , regex-tdfa + , resource-pool , safe , scientific , string-conversions diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 35595153d..fe77fb329 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -1,19 +1,18 @@ module Feature.AuthSpec where -- {{{ Imports +import Data.Pool import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types - -import Hasql as H -import Hasql.Postgres as P +import qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) -- }}} -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = around (withApp cfgDefault struct pool) $ describe "authorization" $ do diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index 8bc7f600c..a59e71b6e 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -1,13 +1,12 @@ module Feature.CorsSpec where -- {{{ Imports +import Data.Pool import Test.Hspec 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 qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) @@ -15,7 +14,7 @@ import PostgREST.Types (DbStructure(..)) import Network.HTTP.Types -- }}} -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = around (withApp cfgDefault struct pool) $ describe "CORS" $ do let preflightHeaders = [ ("Accept", "*/*"), diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index 23751141f..8f9f9761f 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -1,18 +1,17 @@ module Feature.DeleteSpec where +import Data.Pool import Test.Hspec import Test.Hspec.Wai import Text.Heredoc -import Hasql as H -import Hasql.Postgres as P - import SpecHelper import PostgREST.Types (DbStructure(..)) +import qualified Hasql.Connection as H import Network.HTTP.Types -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = beforeAll resetDb . around (withApp cfgDefault struct pool) $ describe "Deleting" $ do diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 17ea3aa04..4a8478daf 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -5,22 +5,21 @@ 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) +import Data.Pool import Text.Heredoc import Network.HTTP.Types.Header import Network.HTTP.Types import Control.Monad (replicateM_) +import qualified Hasql.Connection as H import TestTypes(IncPK(..), CompoundPK(..)) -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do describe "Posting new record" $ do context "disparate csv types" $ do diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs index aad13bb3f..50c404fb1 100644 --- a/test/Feature/QueryLimitedSpec.hs +++ b/test/Feature/QueryLimitedSpec.hs @@ -1,18 +1,17 @@ module Feature.QueryLimitedSpec where +import Data.Pool import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus)) - -import Hasql as H -import Hasql.Postgres as P +import qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = beforeAll resetDb . around (withApp (cfgLimitRows 3) struct pool) $ diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 4cdfcf86f..2e8e72b50 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -1,19 +1,18 @@ module Feature.QuerySpec where +import Data.Pool import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai 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 qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) import Text.Heredoc -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = around (withApp cfgDefault struct pool) $ do describe "Querying a table with a column called count" $ diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs index a8e276272..c75cd4762 100644 --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -1,18 +1,17 @@ module Feature.RangeSpec where +import Data.Pool import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus)) - -import Hasql as H -import Hasql.Postgres as P +import qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = beforeAll resetDb . around (withApp cfgDefault struct pool) $ describe "GET /items" $ do diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 3fca1ce3f..5e7054f31 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -1,18 +1,17 @@ module Feature.StructureSpec where +import Data.Pool import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON - -import Hasql as H -import Hasql.Postgres as P +import qualified Hasql.Connection as H import SpecHelper import PostgREST.Types (DbStructure(..)) import Network.HTTP.Types -spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec :: DbStructure -> Pool H.Connection -> Spec spec struct pool = around (withApp cfgDefault struct pool) $ do describe "GET /" $ do it "lists views in schema" $ diff --git a/test/Main.hs b/test/Main.hs index 81d483a62..234713bd0 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -18,7 +18,7 @@ main :: IO () main = do setupDb - pool <- specDbPool + pool <- testPool dbStructure <- specDbStructure pool -- Not using hspec-discover because we want to precompute diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index ea0de9db5..cbaaeb1a2 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -2,16 +2,8 @@ module SpecHelper where import Network.Wai import Test.Hspec -import Test.Hspec.Wai - -import Hasql as H -import Hasql.Backend as B -import Hasql.Postgres as P import Data.String.Conversions (cs) -import Data.Monoid -import Data.Text hiding (map) -import qualified Data.Vector as V import Data.Time.Clock.POSIX (getPOSIXTime) import Control.Monad (void) @@ -19,57 +11,44 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange, hRange, hAuthorization, hAccept) import Codec.Binary.Base64.String (encode) import Data.CaseInsensitive (CI(..)) -import Data.Maybe (fromMaybe) +import Data.Pool import Text.Regex.TDFA ((=~)) import qualified Data.ByteString.Char8 as BS import System.Process (readProcess) import Web.JWT (secret) +import qualified Hasql.Connection as H +import qualified Hasql.Session as H + import PostgREST.App (app) 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" -cfg :: String -> Maybe Int -> AppConfig +cfg :: String -> Maybe Integer -> AppConfig cfg conStr = AppConfig conStr 3000 "postgrest_test_anonymous" "test" (secret "safe") 10 cfgDefault :: AppConfig cfgDefault = cfg dbString Nothing -cfgLimitRows :: Int -> AppConfig +cfgLimitRows :: Integer -> AppConfig cfgLimitRows = cfg dbString . Just -testPoolOpts :: PoolSettings -testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 - -pgSettings :: P.Settings -pgSettings = P.StringSettings $ cs dbString - -specDbPool :: IO (H.Pool P.Postgres) -specDbPool = H.acquirePool pgSettings testPoolOpts - -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 +withApp :: AppConfig -> DbStructure -> Pool H.Connection -> ActionWith Application -> IO () withApp config dbStructure pool perform = do - perform $ middle $ \req resp -> do + perform $ defaultMiddle $ \req resp -> do time <- getPOSIXTime body <- strictRequestBody req - result <- liftIO $ H.session pool $ H.tx specTxSettings - $ runWithClaims config time (app dbStructure config body) req - either (resp . pgErrResponse) resp result + let handleReq = H.run (runWithClaims config time (app dbStructure config body) req) - where middle = defaultMiddle + withResource pool $ \c -> do + resOrError <- handleReq c + either (resp . pgErrResponse) resp resOrError setupDb :: IO () setupDb = do @@ -107,14 +86,6 @@ authHeaderJWT :: String -> Header authHeaderJWT token = (hAuthorization, cs $ "Bearer " ++ token) -testPool :: IO(H.Pool P.Postgres) -testPool = H.acquirePool pgSettings testPoolOpts - -clearTable :: Text -> IO () -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) +testPool :: IO (Pool (Either H.ConnectionError H.Connection)) +testPool = createPool (H.acquire . cs $ dbString) + (either (const $ return ()) H.release) 1 1 1