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:
Joe Nelson
2016-02-21 12:22:18 -08:00
parent 8a006f07a7
commit d7fe59f0b0
15 changed files with 109 additions and 141 deletions
+3 -5
View File
@@ -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
+3 -6
View File
@@ -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 $
+4 -4
View File
@@ -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"),
+3 -7
View File
@@ -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" $
+3 -4
View File
@@ -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
+3 -6
View File
@@ -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"
+3 -4
View File
@@ -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" $
+4 -5
View File
@@ -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
+4 -4
View File
@@ -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
View File
@@ -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)
]
-27
View File
@@ -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"] []