jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

WIP: share server code between tests and program

Browse Source 
- Share server code in Main
- Switch to hasql-pool
- Use pool in tests
- DRY up test runner
This commit is contained in:
Joe Nelson
2016-02-21 12:22:18 -08:00
parent 8a006f07a7
commit d7fe59f0b0
15 changed files with 109 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+8 -3
View File
@@ -23,7 +23,7 @@ Flag CI
executable postgrest executable postgrest
main-is: PostgREST/Main.hs main-is: PostgREST/Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010 default-language: Haskell2010
build-depends: aeson >= 0.8 && < 0.10 build-depends: aeson >= 0.8 && < 0.10
@@ -35,6 +35,7 @@ executable postgrest
, contravariant , contravariant
, errors , errors
, hasql >= 0.19.3.3 && < 0.20 , hasql >= 0.19.3.3 && < 0.20
, hasql-pool >= 0.4 && < 0.5
, http-types , http-types
, interpolatedstring-perl6 , interpolatedstring-perl6
, jwt , jwt
@@ -42,7 +43,6 @@ executable postgrest
, parsec , parsec
, postgrest , postgrest
, regex-tdfa , regex-tdfa
, resource-pool
, safe >= 0.3 && < 0.4 , safe >= 0.3 && < 0.4
, scientific , scientific
, string-conversions , string-conversions
@@ -86,6 +86,7 @@ library
, contravariant , contravariant
, errors , errors
, hasql , hasql
, hasql-pool
, http-types , http-types
, interpolatedstring-perl6 , interpolatedstring-perl6
, jwt , jwt
@@ -123,7 +124,7 @@ library
Test-Suite spec Test-Suite spec
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Default-Language: Haskell2010 Default-Language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, LambdaCase default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
Hs-Source-Dirs: test, src Hs-Source-Dirs: test, src
Main-Is: Main.hs Main-Is: Main.hs
Other-Modules: Feature.AuthSpec Other-Modules: Feature.AuthSpec
@@ -139,6 +140,7 @@ Test-Suite spec
, PostgREST.Auth , PostgREST.Auth
, PostgREST.Config , PostgREST.Config
, PostgREST.Error , PostgREST.Error
, PostgREST.Main
, PostgREST.Middleware , PostgREST.Middleware
, PostgREST.Parsers , PostgREST.Parsers
, PostgREST.DbStructure , PostgREST.DbStructure
@@ -159,6 +161,7 @@ Test-Suite spec
, contravariant , contravariant
, errors , errors
, hasql , hasql
, hasql-pool
, heredoc , heredoc
, hspec == 2.2.* , hspec == 2.2.*
, hspec-wai , hspec-wai
@@ -179,10 +182,12 @@ Test-Suite spec
, transformers , transformers
, transformers-base , transformers-base
, unordered-containers , unordered-containers
, unix
, vector , vector
, wai , wai
, wai-cors , wai-cors
, wai-extra , wai-extra
, wai-middleware-static , wai-middleware-static
, warp
, HTTP , HTTP
, Ranged-sets , Ranged-sets
src/PostgREST/Error.hs
+21 -10
View File
@@ -7,11 +7,13 @@ module PostgREST.Error (pgErrResponse, errResponse) where
import Data.Aeson ((.=)) import Data.Aeson ((.=))
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Hasql.Session as H import qualified Hasql.Session as H
import qualified Hasql.Pool as P
import Network.HTTP.Types.Header import Network.HTTP.Types.Header
import qualified Network.HTTP.Types.Status as HT import qualified Network.HTTP.Types.Status as HT
import Network.Wai (Response, responseLBS) import Network.Wai (Response, responseLBS)
@@ -19,10 +21,17 @@ import Network.Wai (Response, responseLBS)
errResponse :: HT.Status -> Text -> Response errResponse :: HT.Status -> Text -> Response
errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"]) errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
pgErrResponse :: H.Error -> Response pgErrResponse :: P.UsageError -> Response
pgErrResponse e = responseLBS (httpStatus e) pgErrResponse e = responseLBS (httpStatus e)
[(hContentType, "application/json")] (JSON.encode e) [(hContentType, "application/json")] (JSON.encode e)
instance JSON.ToJSON P.UsageError where
toJSON (P.ConnectionError e) = JSON.object [
"code" .= ("" :: T.Text),
"message" .= ("Connection error" :: T.Text),
"details" .= (cs (fromMaybe "" e) :: T.Text)]
toJSON e = JSON.toJSON e -- H.Error
instance JSON.ToJSON H.Error where instance JSON.ToJSON H.Error where
toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [ toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
"code" .= (cs c::T.Text), "code" .= (cs c::T.Text),
@@ -51,15 +60,17 @@ instance JSON.ToJSON H.Error where
"message" .= ("Database client error"::String), "message" .= ("Database client error"::String),
"details" .= (fmap cs d::Maybe T.Text)] "details" .= (fmap cs d::Maybe T.Text)]
httpStatus :: H.Error -> HT.Status httpStatus :: P.UsageError -> HT.Status
httpStatus (H.ResultError (H.ServerError c _ _ _)) = httpStatus (P.ConnectionError _) =
HT.status500
httpStatus (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
case cs c of case cs c of
'0':'8':_ -> HT.status503 -- pg connection err '0':'8':_ -> HT.status503 -- pg connection err
'0':'9':_ -> HT.status500 -- triggered action exception '0':'9':_ -> HT.status500 -- triggered action exception
'0':'L':_ -> HT.status403 -- invalid grantor '0':'L':_ -> HT.status403 -- invalid grantor
'0':'P':_ -> HT.status403 -- invalid role specification '0':'P':_ -> HT.status403 -- invalid role specification
"23503" -> HT.status409 -- foreign_key_violation "23503" -> HT.status409 -- foreign_key_violation
"23505" -> HT.status409 -- unique_violation "23505" -> HT.status409 -- unique_violation
'2':'5':_ -> HT.status500 -- invalid tx state '2':'5':_ -> HT.status500 -- invalid tx state
'2':'8':_ -> HT.status403 -- invalid auth specification '2':'8':_ -> HT.status403 -- invalid auth specification
'2':'D':_ -> HT.status500 -- invalid tx termination '2':'D':_ -> HT.status500 -- invalid tx termination
@@ -76,8 +87,8 @@ httpStatus (H.ResultError (H.ServerError c _ _ _)) =
'H':'V':_ -> HT.status500 -- foreign data wrapper error 'H':'V':_ -> HT.status500 -- foreign data wrapper error
'P':'0':_ -> HT.status500 -- PL/pgSQL Error 'P':'0':_ -> HT.status500 -- PL/pgSQL Error
'X':'X':_ -> HT.status500 -- internal Error 'X':'X':_ -> HT.status500 -- internal Error
"42P01" -> HT.status404 -- undefined table "42P01" -> HT.status404 -- undefined table
"42501" -> HT.status404 -- insufficient privilege "42501" -> HT.status404 -- insufficient privilege
_ -> HT.status400 _ -> HT.status400
httpStatus (H.ResultError _) = HT.status500 httpStatus (P.SessionError (H.ResultError _)) = HT.status500
httpStatus (H.ClientError _) = HT.status503 httpStatus (P.SessionError (H.ClientError _)) = HT.status503
src/PostgREST/Main.hs
+29 -36
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Main where module PostgREST.Main where
import PostgREST.App import PostgREST.App
@@ -9,21 +9,20 @@ import PostgREST.Config (AppConfig (..),
prettyVersion, prettyVersion,
readOptions) readOptions)
import PostgREST.DbStructure import PostgREST.DbStructure
import PostgREST.Error (errResponse, pgErrResponse) import PostgREST.Error (pgErrResponse)
import PostgREST.Middleware import PostgREST.Middleware
import PostgREST.Types (DbStructure)
import PostgREST.QueryBuilder (inTransaction, Isolation(..)) import PostgREST.QueryBuilder (inTransaction, Isolation(..))
import Control.Monad import Control.Monad
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Pool
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Hasql.Query as H import qualified Hasql.Query as H
import qualified Hasql.Connection as H
import qualified Hasql.Session as H import qualified Hasql.Session as H
import qualified Hasql.Decoders as HD import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE import qualified Hasql.Encoders as HE
import qualified Network.HTTP.Types.Status as HT import qualified Hasql.Pool as P
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger (logStdout) import Network.Wai.Middleware.RequestLogger (logStdout)
@@ -55,51 +54,45 @@ main = do
conf <- readOptions conf <- readOptions
let port = configPort conf let port = configPort conf
pgSettings = cs (configDatabase conf)
appSettings = setPort port
. setServerName (cs $ "postgrest/" <> prettyVersion)
$ defaultSettings
unless (secret "secret" /= configJwtSecret conf) $ unless (secret "secret" /= configJwtSecret conf) $
putStrLn "WARNING, running in insecure mode, JWT secret is the default value" putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
Prelude.putStrLn $ "Listening on port " ++ Prelude.putStrLn $ "Listening on port " ++
(show $ configPort conf :: String) (show $ configPort conf :: String)
let pgSettings = cs (configDatabase conf)
appSettings = setPort port
. setServerName (cs $ "postgrest/" <> prettyVersion)
$ defaultSettings
middle = logStdout . defaultMiddle
pool <- createPool (H.acquire pgSettings) pool <- P.acquire (configPool conf, 10, pgSettings)
(either (const $ return ()) H.release) 1 1 (configPool conf)
dbStructure <- withResource pool $ \case
Left err -> error $ show err
Right c -> do
supported <- H.run isServerVersionSupported c
case supported of
Left e -> error $ show e
Right good -> unless good $
error (
"Cannot run in this PostgreSQL version, PostgREST needs at least "
<> show minimumPgVersion)
dbOrError <- H.run (getDbStructure (cs $ configSchema conf)) c
either (error . show) return dbOrError
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
tid <- myThreadId tid <- myThreadId
void $ installHandler keyboardSignal (Catch $ do void $ installHandler keyboardSignal (Catch $ do
destroyAllResources pool P.release pool
throwTo tid UserInterrupt throwTo tid UserInterrupt
) Nothing ) Nothing
#endif #endif
runSettings appSettings $ middle $ \ req respond -> do result <- P.use pool $ do
supported <- isServerVersionSupported
unless supported $ error (
"Cannot run in this PostgreSQL version, PostgREST needs at least "
<> show minimumPgVersion)
getDbStructure (cs $ configSchema conf)
let dbStructure = either (error.show) id result
runSettings appSettings $ postgrest conf dbStructure pool
postgrest :: AppConfig -> DbStructure -> P.Pool -> Application
postgrest conf dbStructure pool =
let middle = logStdout . defaultMiddle in
middle $ \ req respond -> do
time <- getPOSIXTime time <- getPOSIXTime
body <- strictRequestBody req body <- strictRequestBody req
let handleReq = H.run $ inTransaction ReadCommitted let handleReq = inTransaction ReadCommitted $
(runWithClaims conf time (app dbStructure conf body) req) runWithClaims conf time (app dbStructure conf body) req
res <- withResource pool $ \case resp <- either pgErrResponse id <$> P.use pool handleReq
Left err -> return $ errResponse HT.status500 (cs . show $ err) respond resp
Right c -> do
resOrError <- handleReq c
return $ either pgErrResponse id resOrError
respond res
stack.yaml
+1
View File
@@ -1,6 +1,7 @@
resolver: lts-5.0 resolver: lts-5.0
extra-deps: extra-deps:
- hasql-0.19.3.3 - hasql-0.19.3.3
- hasql-pool-0.4
- Ranged-sets-0.3.0 - Ranged-sets-0.3.0
- packdeps-0.4.2.1 - packdeps-0.4.2.1
ghc-options: ghc-options:
test/Feature/AuthSpec.hs
+3 -5
View File
@@ -5,15 +5,13 @@ import Test.Hspec
import Test.Hspec.Wai import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Network.HTTP.Types import Network.HTTP.Types
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..)) import Network.Wai (Application)
-- }}} -- }}}
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = around (withApp cfgDefault struct c) spec = describe "authorization" $ do
$ describe "authorization" $ do
it "hides tables that anonymous does not own" $ it "hides tables that anonymous does not own" $
get "/authors_only" `shouldRespondWith` 404 get "/authors_only" `shouldRespondWith` 404
test/Feature/ConcurrentSpec.hs
+3 -6
View File
@@ -13,14 +13,11 @@ import Test.Hspec.Wai.Internal
import Test.Hspec.Wai import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Network.Wai.Test (Session) import Network.Wai.Test (Session)
import qualified Hasql.Connection as H
import SpecHelper import Network.Wai (Application)
import PostgREST.Types (DbStructure(..))
spec :: DbStructure -> H.Connection -> Spec
spec struct c = around (withApp cfgDefault struct c) $
spec :: SpecWith Application
spec =
describe "Queryiny in parallel" $ describe "Queryiny in parallel" $
it "should not raise 'transaction in progress' error" $ it "should not raise 'transaction in progress' error" $
raceTest 3 $ raceTest 3 $
test/Feature/CorsSpec.hs
+4 -4
View File
@@ -5,16 +5,16 @@ 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))
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..))
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai (Application)
-- }}} -- }}}
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do spec =
describe "CORS" $ do
let preflightHeaders = [ let preflightHeaders = [
("Accept", "*/*"), ("Accept", "*/*"),
("Origin", "http://example.com"), ("Origin", "http://example.com"),
test/Feature/DeleteSpec.hs
+3 -7
View File
@@ -4,15 +4,11 @@ import Test.Hspec
import Test.Hspec.Wai import Test.Hspec.Wai
import Text.Heredoc import Text.Heredoc
import SpecHelper
import PostgREST.Types (DbStructure(..))
import qualified Hasql.Connection as H
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai (Application)
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = beforeAll resetDb spec =
. 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" $
test/Feature/InsertSpec.hs
+3 -4
View File
@@ -6,7 +6,6 @@ import Test.Hspec.Wai.JSON
import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus)) import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..))
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
@@ -14,12 +13,12 @@ import Text.Heredoc
import Network.HTTP.Types.Header import Network.HTTP.Types.Header
import Network.HTTP.Types import Network.HTTP.Types
import Control.Monad (replicateM_) import Control.Monad (replicateM_)
import qualified Hasql.Connection as H
import TestTypes(IncPK(..), CompoundPK(..)) import TestTypes(IncPK(..), CompoundPK(..))
import Network.Wai (Application)
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do spec = do
describe "Posting new record" $ do describe "Posting new record" $ do
context "disparate json types" $ do context "disparate json types" $ do
it "accepts disparate json types" $ do it "accepts disparate json types" $ do
test/Feature/QueryLimitedSpec.hs
+3 -6
View File
@@ -5,15 +5,12 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus)) import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..)) import Network.Wai (Application)
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = spec =
beforeAll resetDb
. 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"
test/Feature/QuerySpec.hs
+3 -4
View File
@@ -5,14 +5,13 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders)) import Network.Wai.Test (SResponse(simpleHeaders))
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..))
import Text.Heredoc import Text.Heredoc
import Network.Wai (Application)
spec :: DbStructure -> H.Connection -> Spec spec :: SpecWith Application
spec struct c = around (withApp cfgDefault struct c) $ do spec = 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" $
test/Feature/RangeSpec.hs
+4 -5
View File
@@ -5,14 +5,13 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus)) import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..)) import Network.Wai (Application)
spec :: SpecWith Application
spec =
spec :: DbStructure -> H.Connection -> Spec
spec struct c = beforeAll resetDb
. around (withApp cfgDefault struct c) $
describe "GET /items" $ do describe "GET /items" $ do
context "without range headers" $ do context "without range headers" $ do
test/Feature/StructureSpec.hs
+4 -4
View File
@@ -3,15 +3,15 @@ module Feature.StructureSpec where
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
import qualified Hasql.Connection as H
import SpecHelper import SpecHelper
import PostgREST.Types (DbStructure(..))
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai (Application)
spec :: SpecWith Application
spec = do
spec :: DbStructure -> H.Connection -> Spec
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 "/" [] ""
test/Main.hs
+20 -20
View File
@@ -3,10 +3,10 @@ module Main where
import Test.Hspec import Test.Hspec
import SpecHelper import SpecHelper
import qualified Hasql.Session as H import qualified Hasql.Pool as P
import qualified Hasql.Connection as H
import PostgREST.DbStructure (getDbStructure) import PostgREST.DbStructure (getDbStructure)
import PostgREST.Main (postgrest)
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Feature.AuthSpec import qualified Feature.AuthSpec
@@ -23,23 +23,23 @@ main :: IO ()
main = do main = do
setupDb setupDb
H.acquire (cs dbString) >>= \case pool <- P.acquire (10, 10, cs dbString)
Left err -> error $ show err
Right c -> do result <- P.use pool $ getDbStructure "test"
dbOrErr <- H.run (getDbStructure "test") c let dbStructure = either (error.show) id result
-- Not using hspec-discover because we want to precompute withApp = ($ postgrest cfgDefault dbStructure pool)
-- the db structure and pass it to specs for speed
either (error.show) (hspec . specs c) dbOrErr hspec . sequence_ . map (around withApp) $ specs
H.release c
where where
specs conn dbStructure = do specs = map (uncurry describe) [
describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn ("Feature.AuthSpec" , Feature.AuthSpec.spec)
describe "Feature.ConcurrentSpec" $ Feature.ConcurrentSpec.spec dbStructure conn , ("Feature.ConcurrentSpec" , Feature.ConcurrentSpec.spec)
describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure conn , ("Feature.CorsSpec" , Feature.CorsSpec.spec)
describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure conn , ("Feature.DeleteSpec" , Feature.DeleteSpec.spec)
describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure conn , ("Feature.InsertSpec" , Feature.InsertSpec.spec)
describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure conn , ("Feature.QueryLimitedSpec" , Feature.QueryLimitedSpec.spec)
describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure conn , ("Feature.QuerySpec" , Feature.QuerySpec.spec)
describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure conn , ("Feature.RangeSpec" , Feature.RangeSpec.spec)
describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure conn , ("Feature.StructureSpec" , Feature.StructureSpec.spec)
]
test/SpecHelper.hs
-27
View File
@@ -1,10 +1,6 @@
module SpecHelper where module SpecHelper where
import Network.Wai
import Test.Hspec
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Control.Monad (void) import Control.Monad (void)
import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange, import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
@@ -16,15 +12,7 @@ import qualified Data.ByteString.Char8 as BS
import System.Process (readProcess) import System.Process (readProcess)
import Web.JWT (secret) 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.Config (AppConfig(..))
import PostgREST.Middleware
import PostgREST.Error(pgErrResponse)
import PostgREST.Types
import PostgREST.QueryBuilder (inTransaction, Isolation(..))
dbString :: String dbString :: String
dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test" dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
@@ -38,21 +26,6 @@ cfgDefault = cfg dbString Nothing
cfgLimitRows :: Integer -> AppConfig cfgLimitRows :: Integer -> AppConfig
cfgLimitRows = cfg dbString . Just cfgLimitRows = cfg dbString . Just
withApp :: AppConfig -> DbStructure -> H.Connection
-> ActionWith Application -> IO ()
withApp config dbStructure c perform =
perform $ defaultMiddle $ \req resp -> do
time <- getPOSIXTime
body <- strictRequestBody req
let handleReq = H.run $ inTransaction ReadCommitted
(runWithClaims config time (app dbStructure config body) req)
handleReq c >>= \case
Left err -> do
void $ H.run (H.sql "rollback;") c
resp $ pgErrResponse err
Right res -> resp res
setupDb :: IO () setupDb :: IO ()
setupDb = do setupDb = do
void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] [] void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []