From d5c1438c6e3e2b6367e8db2ab114167a5ba3c93d Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 21 Feb 2016 18:05:25 -0800 Subject: [PATCH] Use hasql-transaction Also use hspec before-wrapper --- postgrest.cabal | 3 +++ src/PostgREST/App.hs | 4 ++-- src/PostgREST/Main.hs | 9 +++++---- src/PostgREST/Middleware.hs | 6 +++--- src/PostgREST/QueryBuilder.hs | 20 -------------------- stack.yaml | 3 +++ test/Main.hs | 4 ++-- 7 files changed, 18 insertions(+), 31 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index 81b62457b..c4a289da4 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -36,6 +36,7 @@ executable postgrest , errors , hasql >= 0.19.3.3 && < 0.20 , hasql-pool >= 0.4 && < 0.5 + , hasql-transaction >= 0.4 && < 0.5 , http-types , interpolatedstring-perl6 , jwt @@ -86,6 +87,7 @@ library , contravariant , errors , hasql + , hasql-transaction , hasql-pool , http-types , interpolatedstring-perl6 @@ -162,6 +164,7 @@ Test-Suite spec , errors , hasql , hasql-pool + , hasql-transaction , heredoc , hspec == 2.2.* , hspec-wai diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 418a84f55..000d66544 100644 --- a/src/PostgREST/App.hs +++ b/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) diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 323190b0e..1200aea5e 100644 --- a/src/PostgREST/Main.hs +++ b/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 diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index 4292e261c..e68ddbc6f 100644 --- a/src/PostgREST/Middleware.hs +++ b/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 diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 0da811869..046040909 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/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" diff --git a/stack.yaml b/stack.yaml index e88e4a6de..4bfc24c5e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,8 +2,11 @@ resolver: lts-5.0 extra-deps: - hasql-0.19.3.3 - hasql-pool-0.4 + - hasql-transaction-0.4.2 - Ranged-sets-0.3.0 - packdeps-0.4.2.1 + - bytestring-tree-builder-0.2.5 + - postgresql-error-codes-1 ghc-options: postgrest: -O1 -Werror -Wall -fwarn-monomorphism-restriction -fwarn-missing-exported-sigs -fwarn-identities diff --git a/test/Main.hs b/test/Main.hs index 3d462e577..f3e9f91e1 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -27,9 +27,9 @@ main = do result <- P.use pool $ getDbStructure "test" let dbStructure = either (error.show) id result - withApp = ($ postgrest cfgDefault dbStructure pool) + withApp = return $ postgrest cfgDefault dbStructure pool - hspec . sequence_ . map (around withApp) $ specs + hspec . sequence_ . map (before withApp) $ specs where specs = map (uncurry describe) [