Run queries in a transaction again

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

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"

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