diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index a4075e3f2..dcfb4e4ee 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -11,6 +11,7 @@ import PostgREST.Config (AppConfig (..), import PostgREST.DbStructure import PostgREST.Error (errResponse, pgErrResponse) import PostgREST.Middleware +import PostgREST.QueryBuilder (inTransaction, Isolation(..)) import Control.Monad (unless, void) import Data.Monoid ((<>)) @@ -94,7 +95,8 @@ main = do runSettings appSettings $ middle $ \ req respond -> do time <- getPOSIXTime body <- strictRequestBody req - let handleReq = H.run (runWithClaims conf time (app dbStructure conf body) req) + let handleReq = H.run $ inTransaction ReadCommitted + (runWithClaims conf time (app dbStructure conf body) req) withResource pool $ \case Left err -> respond $ errResponse HT.status500 (cs . show $ err) Right c -> do diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index ea082642f..4eb7d2dee 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -18,6 +18,7 @@ module PostgREST.QueryBuilder ( , callProc , createReadStatement , createWriteStatement + , inTransaction , operators , pgFmtIdent , pgFmtLit @@ -26,9 +27,11 @@ module PostgREST.QueryBuilder ( , sourceCTEName , unquoted , ResultsWithCount + , Isolation(..) ) where import qualified Hasql.Query as H +import qualified Hasql.Session as H import qualified Hasql.Encoders as HE import qualified Hasql.Decoders as HD @@ -501,3 +504,20 @@ pgFmtAsJsonPath (Just xx) = " AS " <> last xx trimNullChars :: Text -> Text trimNullChars = T.takeWhile (/= '\x0') + +data Isolation = ReadCommitted | RepeatableRead | Serializable + +{- | + Wrap a session in a transaction of desired isolation level +-} +inTransaction :: Isolation -> H.Session a -> H.Session a +inTransaction lvl f = do + H.sql $ "begin " <> isolate <> ";" + r <- f + H.sql "end;" + return r + where + isolate = case lvl of + ReadCommitted -> "ISOLATION LEVEL READ COMMITTED" + RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ" + Serializable -> "ISOLATION LEVEL SERIALIZABLE" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 4d53839c3..6e5edcb40 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -25,6 +25,7 @@ import PostgREST.Config (AppConfig(..)) import PostgREST.Middleware import PostgREST.Error(pgErrResponse) import PostgREST.Types +import PostgREST.QueryBuilder (inTransaction, Isolation(..)) dbString :: String dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test" @@ -44,7 +45,8 @@ withApp config dbStructure c perform = do perform $ defaultMiddle $ \req resp -> do time <- getPOSIXTime body <- strictRequestBody req - let handleReq = H.run (runWithClaims config time (app dbStructure config body) req) + let handleReq = H.run $ inTransaction ReadCommitted + (runWithClaims config time (app dbStructure config body) req) resOrError <- handleReq c either (resp . pgErrResponse) resp resOrError