WIP: share server code between tests and program
- Share server code in Main - Switch to hasql-pool - Use pool in tests - DRY up test runner
This commit is contained in:
@@ -5,15 +5,13 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
import Network.Wai (Application)
|
||||
-- }}}
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c)
|
||||
$ describe "authorization" $ do
|
||||
spec :: SpecWith Application
|
||||
spec = describe "authorization" $ do
|
||||
|
||||
it "hides tables that anonymous does not own" $
|
||||
get "/authors_only" `shouldRespondWith` 404
|
||||
|
||||
@@ -13,14 +13,11 @@ import Test.Hspec.Wai.Internal
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.Wai.Test (Session)
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $
|
||||
import Network.Wai (Application)
|
||||
|
||||
spec :: SpecWith Application
|
||||
spec =
|
||||
describe "Queryiny in parallel" $
|
||||
it "should not raise 'transaction in progress' error" $
|
||||
raceTest 3 $
|
||||
|
||||
@@ -5,16 +5,16 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai (Application)
|
||||
-- }}}
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $ describe "CORS" $ do
|
||||
spec :: SpecWith Application
|
||||
spec =
|
||||
describe "CORS" $ do
|
||||
let preflightHeaders = [
|
||||
("Accept", "*/*"),
|
||||
("Origin", "http://example.com"),
|
||||
|
||||
@@ -4,15 +4,11 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Text.Heredoc
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai (Application)
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = beforeAll resetDb
|
||||
. around (withApp cfgDefault struct c) $
|
||||
spec :: SpecWith Application
|
||||
spec =
|
||||
describe "Deleting" $ do
|
||||
context "existing record" $ do
|
||||
it "succeeds with 204 and deletion count" $
|
||||
|
||||
@@ -6,7 +6,6 @@ import Test.Hspec.Wai.JSON
|
||||
import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import Data.Maybe (fromJust)
|
||||
@@ -14,12 +13,12 @@ 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(..))
|
||||
import Network.Wai (Application)
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = beforeAll_ resetDb $ around (withApp cfgDefault struct c) $ do
|
||||
spec :: SpecWith Application
|
||||
spec = do
|
||||
describe "Posting new record" $ do
|
||||
context "disparate json types" $ do
|
||||
it "accepts disparate json types" $ do
|
||||
|
||||
@@ -5,15 +5,12 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
import Network.Wai (Application)
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c =
|
||||
beforeAll resetDb
|
||||
. around (withApp (cfgLimitRows 3) struct c) $
|
||||
spec :: SpecWith Application
|
||||
spec =
|
||||
describe "Requesting many items with server limits enabled" $ do
|
||||
it "restricts results" $
|
||||
get "/items"
|
||||
|
||||
@@ -5,14 +5,13 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders))
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
import Text.Heredoc
|
||||
import Network.Wai (Application)
|
||||
|
||||
spec :: DbStructure -> H.Connection -> Spec
|
||||
spec struct c = around (withApp cfgDefault struct c) $ do
|
||||
spec :: SpecWith Application
|
||||
spec = do
|
||||
|
||||
describe "Querying a table with a column called count" $
|
||||
it "should not confuse count column with pg_catalog.count aggregate" $
|
||||
|
||||
@@ -5,14 +5,13 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
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
|
||||
|
||||
context "without range headers" $ do
|
||||
|
||||
@@ -3,15 +3,15 @@ module Feature.StructureSpec where
|
||||
import Test.Hspec hiding (pendingWith)
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import qualified Hasql.Connection as H
|
||||
|
||||
import SpecHelper
|
||||
import PostgREST.Types (DbStructure(..))
|
||||
|
||||
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
|
||||
it "lists views in schema" $
|
||||
request methodGet "/" [] ""
|
||||
|
||||
+20
-20
@@ -3,10 +3,10 @@ module Main where
|
||||
import Test.Hspec
|
||||
import SpecHelper
|
||||
|
||||
import qualified Hasql.Session as H
|
||||
import qualified Hasql.Connection as H
|
||||
import qualified Hasql.Pool as P
|
||||
|
||||
import PostgREST.DbStructure (getDbStructure)
|
||||
import PostgREST.Main (postgrest)
|
||||
import Data.String.Conversions (cs)
|
||||
|
||||
import qualified Feature.AuthSpec
|
||||
@@ -23,23 +23,23 @@ main :: IO ()
|
||||
main = do
|
||||
setupDb
|
||||
|
||||
H.acquire (cs dbString) >>= \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
|
||||
H.release c
|
||||
pool <- P.acquire (10, 10, cs dbString)
|
||||
|
||||
result <- P.use pool $ getDbStructure "test"
|
||||
let dbStructure = either (error.show) id result
|
||||
withApp = ($ postgrest cfgDefault dbStructure pool)
|
||||
|
||||
hspec . sequence_ . map (around withApp) $ specs
|
||||
|
||||
where
|
||||
specs conn dbStructure = do
|
||||
describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure conn
|
||||
describe "Feature.ConcurrentSpec" $ Feature.ConcurrentSpec.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
|
||||
specs = map (uncurry describe) [
|
||||
("Feature.AuthSpec" , Feature.AuthSpec.spec)
|
||||
, ("Feature.ConcurrentSpec" , Feature.ConcurrentSpec.spec)
|
||||
, ("Feature.CorsSpec" , Feature.CorsSpec.spec)
|
||||
, ("Feature.DeleteSpec" , Feature.DeleteSpec.spec)
|
||||
, ("Feature.InsertSpec" , Feature.InsertSpec.spec)
|
||||
, ("Feature.QueryLimitedSpec" , Feature.QueryLimitedSpec.spec)
|
||||
, ("Feature.QuerySpec" , Feature.QuerySpec.spec)
|
||||
, ("Feature.RangeSpec" , Feature.RangeSpec.spec)
|
||||
, ("Feature.StructureSpec" , Feature.StructureSpec.spec)
|
||||
]
|
||||
|
||||
@@ -1,10 +1,6 @@
|
||||
module SpecHelper where
|
||||
|
||||
import Network.Wai
|
||||
import Test.Hspec
|
||||
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Control.Monad (void)
|
||||
|
||||
import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
|
||||
@@ -16,15 +12,7 @@ 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.Types
|
||||
import PostgREST.QueryBuilder (inTransaction, Isolation(..))
|
||||
|
||||
dbString :: String
|
||||
dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
|
||||
@@ -38,21 +26,6 @@ cfgDefault = cfg dbString Nothing
|
||||
cfgLimitRows :: Integer -> AppConfig
|
||||
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 = do
|
||||
void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] []
|
||||
|
||||
Reference in New Issue
Block a user