Use hasql-transaction

Also use hspec before-wrapper

src/PostgREST/App.hs

@@ -31,7 +31,7 @@ import           Data.Aeson
 import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
 import qualified Data.Vector               as V
-import qualified Hasql.Session             as H
+import qualified Hasql.Transaction         as H
 
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
@@ -58,7 +58,7 @@ import           PostgREST.QueryBuilder ( callProc
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Session Response
+app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Transaction Response
 app dbStructure conf reqBody req =
   let
       -- TODO: blow up for Left values (there is a middleware that checks the headers)

src/PostgREST/Main.hs

@@ -12,7 +12,6 @@ import           PostgREST.DbStructure
 import           PostgREST.Error                      (pgErrResponse)
 import           PostgREST.Middleware
 import           PostgREST.Types                      (DbStructure)
-import           PostgREST.QueryBuilder               (inTransaction, Isolation(..))
 
 import           Control.Monad
 import           Data.Monoid                          ((<>))
@@ -20,6 +19,7 @@ import           Data.String.Conversions              (cs)
 import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import qualified Hasql.Query                          as H
 import qualified Hasql.Session                        as H
+import qualified Hasql.Transaction                    as HT
 import qualified Hasql.Decoders                       as HD
 import qualified Hasql.Encoders                       as HE
 import qualified Hasql.Pool                           as P
@@ -92,7 +92,8 @@ postgrest conf dbStructure pool =
   middle $ \ req respond -> do
     time <- getPOSIXTime
     body <- strictRequestBody req
-    let handleReq = inTransaction ReadCommitted $
-          runWithClaims conf time (app dbStructure conf body) req
-    resp <- either pgErrResponse id <$> P.use pool handleReq
+
+    let handleReq = runWithClaims conf time (app dbStructure conf body) req
+    resp <- either pgErrResponse id <$> P.use pool
+      (HT.run handleReq HT.ReadCommitted HT.Write)
     respond resp

src/PostgREST/Middleware.hs

@@ -7,7 +7,7 @@ import           Data.Maybe                    (fromMaybe)
 import           Data.Text
 import           Data.String.Conversions       (cs)
 import           Data.Time.Clock               (NominalDiffTime)
-import qualified Hasql.Session                 as H
+import qualified Hasql.Transaction             as H
 
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
 import           Network.HTTP.Types.Status     (status415, status400)
@@ -27,8 +27,8 @@ import           Prelude hiding(concat)
 import qualified Data.Map.Lazy           as M
 
 runWithClaims :: AppConfig -> NominalDiffTime ->
-                 (Request -> H.Session Response) ->
-                 Request -> H.Session Response
+                 (Request -> H.Transaction Response) ->
+                 Request -> H.Transaction Response
 runWithClaims conf time app req = do
     H.sql setAnon
     case split (== ' ') (cs auth) of

src/PostgREST/QueryBuilder.hs

@@ -18,7 +18,6 @@ module PostgREST.QueryBuilder (
   , callProc
   , createReadStatement
   , createWriteStatement
-  , inTransaction
   , operators
   , pgFmtIdent
   , pgFmtLit
@@ -27,11 +26,9 @@ 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
 
@@ -504,20 +501,3 @@ 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 "commit;"
-  return r
- where
-  isolate = case lvl of
-    ReadCommitted  -> "ISOLATION LEVEL READ COMMITTED"
-    RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"
-    Serializable   -> "ISOLATION LEVEL SERIALIZABLE"