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

WIP: fixing compiler errors in specs

Browse Source
This commit is contained in:
Joe Nelson
2016-01-24 18:09:19 -08:00
parent 3844f3ee96
commit fec316b087
11 changed files with 42 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+2 -1
View File
@@ -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
test/Feature/AuthSpec.hs
+3 -4
View File
@@ -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
test/Feature/CorsSpec.hs
+3 -4
View File
@@ -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", "*/*"),
test/Feature/DeleteSpec.hs
+3 -4
View File
@@ -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
test/Feature/InsertSpec.hs
+3 -4
View File
@@ -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
test/Feature/QueryLimitedSpec.hs
+3 -4
View File
@@ -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) $
test/Feature/QuerySpec.hs
+3 -4
View File
@@ -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" $
test/Feature/RangeSpec.hs
+3 -4
View File
@@ -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
test/Feature/StructureSpec.hs
+3 -4
View File
@@ -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" $
test/Main.hs
+1 -1
View File
@@ -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
test/SpecHelper.hs
+15 -44
View File
@@ -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