From f58e3db924ebfa26b98dbf452fabc75a744815fb Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Tue, 4 Nov 2014 13:09:46 -0800 Subject: [PATCH] Disable transactions for read-only requests --- dbapi.cabal | 2 +- src/Main.hs | 6 +++--- src/Middleware.hs | 35 +++++++++++++++++++++++++---------- test/SpecHelper.hs | 4 ++-- test/Unit/ErrorsSpec.hs | 4 ++-- 5 files changed, 33 insertions(+), 18 deletions(-) diff --git a/dbapi.cabal b/dbapi.cabal index ad548cec8..ee832720a 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -1,5 +1,5 @@ name: dbapi -version: 0.2.4.4 +version: 0.2.4.5 synopsis: The database is your api license: MIT license-file: LICENSE diff --git a/src/Main.hs b/src/Main.hs index c992a2054..02a759497 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,7 +4,7 @@ import Paths_dbapi (version) import Dbapi import Middleware (inTransaction, authenticated, withSavepoint, clientErrors, - redirectInsecure, withDBConnection) + redirectInsecure, withDBConnection, Environment(..)) import Network.Wai.Handler.Warp hiding (Connection) import Data.String.Conversions (cs) @@ -54,8 +54,8 @@ main = do runSettings settings $ (if configSecure conf then redirectInsecure else id) . gzip def . cors corsPolicy . clientErrors . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) - . withDBConnection pool . inTransaction - . authenticated (cs $ configAnonRole conf) . withSavepoint $ app + . withDBConnection pool . inTransaction Production + . authenticated (cs $ configAnonRole conf) . withSavepoint Production $ app ) where describe = progDesc "create a REST API to an existing Postgres database" diff --git a/src/Middleware.hs b/src/Middleware.hs index 18e308293..c27443bf7 100644 --- a/src/Middleware.hs +++ b/src/Middleware.hs @@ -20,26 +20,41 @@ import Network.HTTP.Types.Header (RequestHeaders, hContentType, hAuthorization, hLocation) import Network.HTTP.Types.Status (status400, status401, status404, status301) import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo, - rawQueryString, isSecure) + rawQueryString, isSecure, requestMethod, Request) import Network.URI (URI(..), parseURI) import PgQuery(LoginAttempt(..), signInRole, setRole, resetRole) import Codec.Binary.Base64.String (decode) +import Debug.Trace + +data Environment = Test | Production deriving (Eq) withDBConnection :: Pool Connection -> (Connection -> Application) -> Application withDBConnection pool app req respond = withResource pool (\c -> app c req respond) -inTransaction :: (Connection -> Application) -> Connection -> Application -inTransaction app conn req respond = - finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit") +inTransaction :: Environment -> (Connection -> Application) -> + Connection -> Application +inTransaction env app conn req respond = + if env == Production && readOnlyRequest req + then + app conn req respond + else + finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit") -withSavepoint :: (Connection -> Application) -> Connection -> Application -withSavepoint app conn req respond = do - runRaw conn "savepoint req_sp" - catch (app conn req respond) (\e -> let _ = (e::SomeException) in - runRaw conn "rollback to savepoint req_sp" >> throw e) +readOnlyRequest :: Request -> Bool +readOnlyRequest req = requestMethod req `elem` ["GET", "HEAD", "OPTIONS"] + +withSavepoint :: Environment -> (Connection -> Application) -> + Connection -> Application +withSavepoint env app conn req respond = + if env == Production && readOnlyRequest req + then app conn req respond + else do + runRaw conn "savepoint req_sp" + catch (app conn req respond) (\e -> let _ = (e::SomeException) in + runRaw conn "rollback to savepoint req_sp" >> throw e) authenticated :: BS.ByteString -> (Connection -> Application) -> Connection -> Application @@ -84,7 +99,7 @@ clientErrors app req respond = where isPgException :: SqlError -> Maybe SqlError - isPgException = Just + isPgException x = Just (traceShow x x) redirectInsecure :: Application -> Application diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 1428e3a5b..65a09bf57 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -18,7 +18,7 @@ import Text.Regex.TDFA ((=~)) import qualified Data.ByteString.Char8 as BS import Network.Wai.Middleware.Cors (cors) -import Middleware(clientErrors, withSavepoint, authenticated) +import Middleware(clientErrors, withSavepoint, authenticated, Environment(..)) import Dbapi (app, corsPolicy, AppConfig(..)) import PgQuery(addUser) @@ -65,7 +65,7 @@ appWithFixture :: ActionWith Application -> IO () appWithFixture action = withDatabaseConnection $ \c -> do runRaw c "begin;" action $ cors corsPolicy . clientErrors $ - (authenticated "dbapi_anonymous" . withSavepoint) app c + (authenticated "dbapi_anonymous" . withSavepoint Test) app c rollback c rangeHdrs :: ByteRange -> [Header] diff --git a/test/Unit/ErrorsSpec.hs b/test/Unit/ErrorsSpec.hs index c5d871b5a..d7ef231e2 100644 --- a/test/Unit/ErrorsSpec.hs +++ b/test/Unit/ErrorsSpec.hs @@ -4,7 +4,7 @@ import Test.Hspec import Database.HDBC (runRaw, quickQuery, fromSql, SqlError) import SpecHelper (dbWithSchema) -import Middleware (withSavepoint) +import Middleware (withSavepoint, Environment(..)) import PgQuery (insert) import Types(SqlRow(..)) import Control.Exception(catch) @@ -24,7 +24,7 @@ spec = let describe "withSavepoint" $ it "allows partial rollback of request" $ \c -> do - let app = withSavepoint dbErrApp c + let app = withSavepoint Test dbErrApp c [[beforeCount]] <- quickQuery c "select count(*) from \"1\".items" [] runRaw c "set role dbapi_anonymous" _ <- insert "1" "items" (SqlRow []) c