Tests compile, run, and fail
Temporarily disabled unit tests
This commit is contained in:
+2
-1
@@ -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
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)
|
||||
|
||||
Vendored
+3
-4
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user