diff --git a/dbapi.cabal b/dbapi.cabal index 0865c21e5..b1ae0a2dd 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -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 diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 index 000000000..8930dc347 --- /dev/null +++ b/src/Config.hs @@ -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 -> [] diff --git a/src/Main.hs b/src/Main.hs index 886eb132e..c877d3b96 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 -> [] diff --git a/test/Main.hs b/test/Main.hs index 6a36d32da..abe226374 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -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 diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 65a09bf57..ca42e9092 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -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] diff --git a/test/TestTypes.hs b/test/TestTypes.hs index 95998406d..e5e02bc87 100644 --- a/test/TestTypes.hs +++ b/test/TestTypes.hs @@ -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) diff --git a/test/Unit/ErrorsSpec.hs b/test/Unit/ErrorsSpec.hx similarity index 100% rename from test/Unit/ErrorsSpec.hs rename to test/Unit/ErrorsSpec.hx diff --git a/test/Unit/PgQuerySpec.hs b/test/Unit/PgQuerySpec.hx similarity index 100% rename from test/Unit/PgQuerySpec.hs rename to test/Unit/PgQuerySpec.hx diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hx similarity index 100% rename from test/Unit/PgStructureSpec.hs rename to test/Unit/PgStructureSpec.hx diff --git a/test/fixtures/roles.sql b/test/fixtures/roles.sql index ecc1020a8..db8a90f55 100644 --- a/test/fixtures/roles.sql +++ b/test/fixtures/roles.sql @@ -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;