Tests compile, run, and fail

Temporarily disabled unit tests
This commit is contained in:
Joe Nelson
2014-12-06 17:42:19 -08:00
parent d791f3939e
commit dd2adf4daa
10 changed files with 93 additions and 87 deletions
+2 -1
View File
@@ -37,6 +37,7 @@ executable dbapi
, resource-pool, process
, blaze-builder
Other-Modules: App
, Config
, PgStructure
, PgQuery
, RangeQuery
@@ -51,7 +52,7 @@ Test-Suite spec
Hs-Source-Dirs: test, src
ghc-options: -Wall -W -Werror
Main-Is: Main.hs
Other-Modules: App, Spec, SpecHelper
Other-Modules: App, Config, Spec, SpecHelper
Build-Depends: base, hspec2, QuickCheck
, hspec-wai >= 0.5.0, hspec-wai-json
, postgresql-simple >= 0.4.7.0
+49
View File
@@ -0,0 +1,49 @@
module Config where
import Network.Wai
import Control.Applicative
import Data.Text (strip)
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteString.Char8 as BS
import Data.String.Conversions (cs)
import Options.Applicative hiding (columns)
import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
data AppConfig = AppConfig {
configDbUri :: String
, configPort :: Int
, configAnonRole :: String
, configSecure :: Bool
, configPool :: Int
}
argParser :: Parser AppConfig
argParser = AppConfig
<$> strOption (long "db" <> short 'd' <> metavar "URI"
<> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
<*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
<> help "port number on which to run HTTP server")
<*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE"
<> help "postgres role to use for non-authenticated requests")
<*> switch (long "secure" <> short 's'
<> help "Redirect all requests to HTTPS")
<*> option (long "db-pool" <> metavar "NUMBER" <> value 10
<> help "Max connections in database pool")
defaultCorsPolicy :: CorsResourcePolicy
defaultCorsPolicy = CorsResourcePolicy Nothing
["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
(Just $ 60*60*24) False False True
corsPolicy :: Request -> Maybe CorsResourcePolicy
corsPolicy req = case lookup "origin" headers of
Just origin -> Just defaultCorsPolicy {
corsOrigins = Just ([origin], True)
, corsRequestHeaders = "Authentication":accHeaders
}
Nothing -> Nothing
where
headers = requestHeaders req
accHeaders = case lookup "access-control-request-headers" headers of
Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
Nothing -> []
+4 -47
View File
@@ -5,45 +5,21 @@ import Paths_dbapi (version)
import App
import Middleware (inTransaction, authenticated, withSavepoint, clientErrors,
redirectInsecure, withDBConnection, Environment(..))
import Data.String.Conversions (cs)
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteString.Char8 as BS
import Control.Monad (unless)
import Control.Applicative
import Control.Exception(bracket)
import Options.Applicative hiding (columns)
import Network.Wai
import Data.String.Conversions (cs)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Handler.Warp hiding (Connection)
import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Middleware.Cors (cors, CorsResourcePolicy(..))
import Network.Wai.Middleware.Static (staticPolicy, only)
import Data.Pool(createPool, destroyAllResources)
import Data.List (intercalate)
import Data.Version (versionBranch)
import Data.Text (strip)
import Database.PostgreSQL.Simple
import Options.Applicative hiding (columns)
data AppConfig = AppConfig {
configDbUri :: String
, configPort :: Int
, configAnonRole :: String
, configSecure :: Bool
, configPool :: Int
}
argParser :: Parser AppConfig
argParser = AppConfig
<$> strOption (long "db" <> short 'd' <> metavar "URI"
<> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
<*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
<> help "port number on which to run HTTP server")
<*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE"
<> help "postgres role to use for non-authenticated requests")
<*> switch (long "secure" <> short 's'
<> help "Redirect all requests to HTTPS")
<*> option (long "db-pool" <> metavar "NUMBER" <> value 10
<> help "Max connections in database pool")
import Config (AppConfig(..), argParser, corsPolicy)
main :: IO ()
main = do
@@ -71,22 +47,3 @@ main = do
where
describe = progDesc "create a REST API to an existing Postgres database"
prettyVersion = intercalate "." $ map show $ versionBranch version
defaultCorsPolicy :: CorsResourcePolicy
defaultCorsPolicy = CorsResourcePolicy Nothing
["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
(Just $ 60*60*24) False False True
corsPolicy :: Request -> Maybe CorsResourcePolicy
corsPolicy req = case lookup "origin" headers of
Just origin -> Just defaultCorsPolicy {
corsOrigins = Just ([origin], True)
, corsRequestHeaders = "Authentication":accHeaders
}
Nothing -> Nothing
where
headers = requestHeaders req
accHeaders = case lookup "access-control-request-headers" headers of
Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
Nothing -> []
+5 -5
View File
@@ -1,6 +1,6 @@
module Main where
import Database.HDBC (runRaw, disconnect)
import Database.PostgreSQL.Simple
import Test.Hspec
import Spec
import SpecHelper (openConnection, loadFixture)
@@ -8,10 +8,10 @@ import SpecHelper (openConnection, loadFixture)
main :: IO ()
main = do
c <-openConnection
runRaw c "drop schema if exists \"1\" cascade"
runRaw c "drop schema if exists private cascade"
runRaw c "drop schema if exists dbapi cascade"
_ <- execute_ c "drop schema if exists \"1\" cascade"
_ <- execute_ c "drop schema if exists private cascade"
_ <- execute_ c "drop schema if exists dbapi cascade"
loadFixture "roles" c
loadFixture "schema" c
disconnect c
close c
hspec spec
+16 -14
View File
@@ -4,11 +4,12 @@ import Network.Wai
import Test.Hspec
import Test.Hspec.Wai
import Database.HDBC
import Database.HDBC.PostgreSQL
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Types
import Data.String.Conversions (cs)
import Control.Exception.Base (bracket, finally)
import Control.Monad (void)
import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
hRange, hAuthorization)
@@ -20,8 +21,9 @@ import Network.Wai.Middleware.Cors (cors)
import Middleware(clientErrors, withSavepoint, authenticated, Environment(..))
import Dbapi (app, corsPolicy, AppConfig(..))
import PgQuery(addUser)
import App (app)
import Config (corsPolicy, AppConfig(..))
import Auth (addUser)
isLeft :: Either a b -> Bool
isLeft (Left _ ) = True
@@ -31,41 +33,41 @@ cfg :: AppConfig
cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "dbapi_anonymous" False 10
openConnection :: IO Connection
openConnection = connectPostgreSQL' $ configDbUri cfg
openConnection = connectPostgreSQL $ cs $ configDbUri cfg
withDatabaseConnection :: (Connection -> IO ()) -> IO ()
withDatabaseConnection = bracket openConnection disconnect
withDatabaseConnection = bracket openConnection close
loadFixture :: String -> Connection -> IO ()
loadFixture name conn = do
sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
runRaw conn sql
void $ execute_ conn $ Query (cs sql)
dbWithSchema :: ActionWith Connection -> IO ()
dbWithSchema action = withDatabaseConnection $ \c -> do
runRaw c "begin;"
_ <- execute_ c "begin;"
action c
rollback c
withUser :: BS.ByteString -> BS.ByteString -> BS.ByteString ->
ActionWith Connection -> ActionWith Connection
withUser name pass role action conn = do
addUser name pass role conn
_ <- addUser conn name pass role
finally (action conn) $ do
_ <- run conn "delete from dbapi.auth where id=?" [toSql name]
runRaw conn "commit"
_ <- execute conn "delete from dbapi.auth where id=?" $ Only name
execute_ conn "commit"
withApp :: ActionWith Application -> ActionWith Connection
withApp action conn = do
runRaw conn "begin;"
_ <- execute_ conn "begin;"
action $ cors corsPolicy $ authenticated "dbapi_anonymous" app conn
rollback conn
appWithFixture :: ActionWith Application -> IO ()
appWithFixture action = withDatabaseConnection $ \c -> do
runRaw c "begin;"
_ <- execute_ c "begin;"
action $ cors corsPolicy . clientErrors $
(authenticated "dbapi_anonymous" . withSavepoint Test) app c
(authenticated "dbapi_anonymous" . Middleware.withSavepoint Test) app c
rollback c
rangeHdrs :: ByteRange -> [Header]
+14 -16
View File
@@ -1,18 +1,16 @@
module TestTypes (
IncPK(..)
, CompoundPK(..)
, incFromList
, compoundFromList
-- , incFromList
-- , compoundFromList
) where
import qualified Data.Aeson as JSON
import Data.Aeson ((.:))
import Data.Maybe (fromJust)
-- import Data.Maybe (fromJust)
import Control.Applicative ((<$>), (<*>))
import Control.Monad (mzero)
import Database.HDBC (SqlValue, fromSql)
data IncPK = IncPK {
incId :: Int
, incNullableStr :: Maybe String
@@ -28,12 +26,12 @@ instance JSON.FromJSON IncPK where
r .: "inserted_at"
parseJSON _ = mzero
incFromList :: [(String, SqlValue)] -> IncPK
incFromList row = IncPK
(fromSql . fromJust $ lookup "id" row)
(fromSql . fromJust $ lookup "nullable_string" row)
(fromSql . fromJust $ lookup "non_nullable_string" row)
(fromSql . fromJust $ lookup "inserted_at" row)
-- incFromList :: [(String, SqlValue)] -> IncPK
-- incFromList row = IncPK
-- (fromSql . fromJust $ lookup "id" row)
-- (fromSql . fromJust $ lookup "nullable_string" row)
-- (fromSql . fromJust $ lookup "non_nullable_string" row)
-- (fromSql . fromJust $ lookup "inserted_at" row)
data CompoundPK = CompoundPK {
compoundK1 :: Int
@@ -48,8 +46,8 @@ instance JSON.FromJSON CompoundPK where
r .: "extra"
parseJSON _ = mzero
compoundFromList :: [(String, SqlValue)] -> CompoundPK
compoundFromList row = CompoundPK
(fromSql . fromJust $ lookup "k1" row)
(fromSql . fromJust $ lookup "k2" row)
(fromSql . fromJust $ lookup "extra" row)
-- compoundFromList :: [(String, SqlValue)] -> CompoundPK
-- compoundFromList row = CompoundPK
-- (fromSql . fromJust $ lookup "k1" row)
-- (fromSql . fromJust $ lookup "k2" row)
-- (fromSql . fromJust $ lookup "extra" row)
+3 -4
View File
@@ -11,7 +11,6 @@ BEGIN
END;
$$;
select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin');
select pg_temp.create_role_if_not_exists('test_default_role', 'with nologin');
select pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin');
select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin') as a
, pg_temp.create_role_if_not_exists('test_default_role', 'with nologin') as b
, pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin') into temp shh;