diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+# 0.2.0.0
+
+* Use a separate monad within `withTransaction` to prevent unsafe/arbitrary IO actions ([#7](https://github.com/brandonchinn178/persistent-mtl/issues/7), [#28](https://github.com/brandonchinn178/persistent-mtl/issues/28))
+* Add `MonadRerunnableIO` to support IO actions within `withTransaction` only if the IO action is determined to be rerunnable
+* Add built-in support for retrying transactions if a serialization error occurs
+* Remove `SqlQueryRep` as an export from `Database.Persist.Monad`. You shouldn't ever need it for normal usage. It is now re-exported by `Database.Persist.Monad.TestUtils`, since most of the usage of `SqlQueryRep` is in mocking queries. If you need it otherwise, you can import it directly from `Database.Persist.Monad.SqlQueryRep`.
+
 # 0.1.0.1
 
 Fix quickstart
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -54,12 +54,12 @@
 instance MonadUnliftIO MyApp where
   withRunInIO = wrappedWithRunInIO MyApp unMyApp
 
-getYoungPeople :: (MonadIO m, MonadSqlQuery m) => m [Entity Person]
+getYoungPeople :: MonadSqlQuery m => m [Entity Person]
 getYoungPeople = selectList [PersonAge <. 18] []
 
 main :: IO ()
-main = runStderrLoggingT $ withSqlitePool "db.sqlite" 5 $ \conn ->
-  liftIO $ runSqlQueryT conn $ unMyApp $ do
+main = runStderrLoggingT $ withSqlitePool "db.sqlite" 5 $ \pool ->
+  liftIO $ runSqlQueryT pool $ unMyApp $ do
     runMigration migrate
     insert_ $ Person "Alice" 25
     insert_ $ Person "Bob" 10
@@ -228,6 +228,59 @@
     `fooAndBar` will run both `foo` and `bar` in the same transaction. Note that `foo` and `bar` themselves don't say anything about transactions. By default, using a `persistent` function without `withTransaction` will run each query in its own transaction. And if `foo` did use `withTransaction`, it would start a transaction within a transaction (if the SQL backend supports it). Now, `foo` and `bar` are composable!
 
 In summary, `persistent-mtl` takes all the good things about option 2, implements them out of the box (so you don't have to do it yourself), and makes your business logic functions composable with transactions behaving the way YOU want.
+
+### Easy transaction management
+
+Some databases will throw an error if two transactions conflict (e.g. [PostgreSQL](https://www.postgresql.org/docs/9.5/transaction-iso.html)). The client is expected to retry transactions if this error is thrown. `persistent` doesn't easily support this out of the box, but `persistent-mtl` does!
+
+```hs
+import Database.PostgreSQL.Simple.Errors (isSerializationError)
+
+main :: IO ()
+main = withPostgresqlPool "..." 5 $ \pool -> do
+  let env = mkSqlQueryEnv pool $ \env -> env
+        { retryIf = isSerializationError . fromException
+        , retryLimit = 100 -- defaults to 10
+        }
+
+  -- in any of the marked transactions below, if someone else is querying
+  -- the postgresql database at the same time with queries that conflict
+  -- with yours, your operations will automatically be retried
+  runSqlQueryTWith env $ do
+    -- transaction 1
+    insert_ $ ...
+
+    -- transaction 2
+    withTransaction $ do
+      insert_ $ ...
+
+      -- transaction 2.5: transaction-within-a-transaction is supported in PostgreSQL
+      withTransaction $ do
+        insert_ $ ...
+
+      insert_ $ ...
+
+    -- transaction 3
+    insert_ $ ...
+```
+
+Because of this built-in retry support, any IO actions inside `withTransaction` have to be explicitly marked with `rerunnableIO`. If you try to use a function with a `MonadIO m` constraint, you'll get a compile-time error!
+
+```
+.../Foo.hs:100:5: error:
+    • Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO
+    • In a stmt of a 'do' block: arbitraryIO
+      In the second argument of ‘($)’, namely
+        ‘withTransaction
+           $ do insert_ record1
+                arbitraryIO
+                insert_ record2’
+    |
+100 |     arbitraryIO
+    |     ^^^^^^^^^^^
+```
+
+Note that this **only** applies for transactions, so `MonadIO` and `MonadSqlQuery` constraints can still co-exist (for a function with IO actions that are not rerunnable) as long as the function is never called within `withTransaction`.
 
 ### Testing functions that use `persistent` operations
 
diff --git a/persistent-mtl.cabal b/persistent-mtl.cabal
--- a/persistent-mtl.cabal
+++ b/persistent-mtl.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9b6ae20631ee5ad633b82ab405f64730ea1603ef8da2099ea41ef126cab9d817
+-- hash: 9c53e0610dea4ca814133d0596978b961b85fd54cb6df7a82eccb6d260824dde
 
 name:           persistent-mtl
-version:        0.1.0.1
+version:        0.2.0.0
 synopsis:       Monad transformer for the persistent API
 description:    A monad transformer and mtl-style type class for using the
                 persistent API directly in your monad transformer stack.
@@ -32,6 +32,7 @@
 
 library
   exposed-modules:
+      Control.Monad.IO.Rerunnable
       Database.Persist.Monad
       Database.Persist.Monad.Class
       Database.Persist.Monad.Shim
@@ -53,6 +54,7 @@
     , resourcet-pool >=0.1.0.0 && <0.2
     , text >=1.2.3.0 && <2
     , transformers >=0.5.2.0 && <0.6
+    , unliftio >=0.2.7.0 && <0.3
     , unliftio-core >=0.1.2.0 && <0.3
   default-language: Haskell2010
 
@@ -66,6 +68,7 @@
       Mocked
       MockSqlQueryT
       SqlQueryRepTest
+      TestUtils.DB
       TestUtils.Match
       Paths_persistent_mtl
   hs-source-dirs:
@@ -79,8 +82,10 @@
     , monad-logger
     , persistent
     , persistent-mtl
+    , persistent-postgresql
     , persistent-sqlite
     , persistent-template
+    , resource-pool
     , resourcet
     , tasty
     , tasty-golden
diff --git a/src/Control/Monad/IO/Rerunnable.hs b/src/Control/Monad/IO/Rerunnable.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/IO/Rerunnable.hs
@@ -0,0 +1,71 @@
+{-|
+Module: Control.Monad.IO.Rerunnable
+
+Defines the 'MonadRerunnableIO' type class that is functionally equivalent
+to 'Control.Monad.IO.Class.MonadIO', but use of it requires the user to
+explicitly acknowledge that the given IO operation can be rerun.
+-}
+
+module Control.Monad.IO.Rerunnable
+  ( MonadRerunnableIO(..)
+  ) where
+
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Trans.Except as Except
+import qualified Control.Monad.Trans.Identity as Identity
+import qualified Control.Monad.Trans.Maybe as Maybe
+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
+import qualified Control.Monad.Trans.Reader as Reader
+import qualified Control.Monad.Trans.Resource as Resource
+import qualified Control.Monad.Trans.State.Lazy as State.Lazy
+import qualified Control.Monad.Trans.State.Strict as State.Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
+
+-- | A copy of 'Control.Monad.IO.Class.MonadIO' to explicitly allow only IO
+-- operations that are rerunnable, e.g. in the context of a SQL transaction.
+class Monad m => MonadRerunnableIO m where
+  -- | Lift the given IO operation to @m@.
+  --
+  -- The given IO operation may be rerun, so use of this function requires
+  -- manually verifying that the given IO operation is rerunnable.
+  rerunnableIO :: IO a -> m a
+
+instance MonadRerunnableIO IO where
+  rerunnableIO = id
+
+{- Instances for common monad transformers -}
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Reader.ReaderT r m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Except.ExceptT e m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Identity.IdentityT m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Maybe.MaybeT m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Lazy.RWST r w s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Strict.RWST r w s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (State.Lazy.StateT s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (State.Strict.StateT s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Lazy.WriterT w m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Strict.WriterT w m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Resource.ResourceT m) where
+  rerunnableIO = lift . rerunnableIO
diff --git a/src/Database/Persist/Monad.hs b/src/Database/Persist/Monad.hs
--- a/src/Database/Persist/Monad.hs
+++ b/src/Database/Persist/Monad.hs
@@ -1,8 +1,11 @@
 {-|
 Module: Database.Persist.Monad
 
-Defines the 'SqlQueryT' monad transformer that has a 'MonadSqlQuery' instance
-to execute @persistent@ database operations.
+Defines the 'SqlQueryT' monad transformer, which has a 'MonadSqlQuery' instance
+to execute @persistent@ database operations. Also provides easy transaction
+management with 'withTransaction', which supports retrying with exponential
+backoff and restricts IO actions to only allow IO actions explicitly marked
+as rerunnable.
 
 Usage:
 
@@ -18,60 +21,155 @@
   liftIO $ print (personList :: [Person])
 
   -- everything in here will run in a transaction
-  withTransaction $
+  withTransaction $ do
     selectFirst [PersonAge >. 30] [] >>= \\case
       Nothing -> insert_ $ Person { name = \"Claire\", age = Just 50 }
       Just (Entity key person) -> replace key person{ age = Just (age person - 10) }
 
+    -- liftIO doesn't work in here, since transactions can be retried.
+    -- Use rerunnableIO to run IO actions, after verifying that the IO action
+    -- can be rerun if the transaction needs to be retried.
+    rerunnableIO $ putStrLn "Transaction is finished!"
+
   -- some more business logic
 
   return ()
 @
 -}
 
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Database.Persist.Monad
   (
   -- * Type class for executing database queries
     MonadSqlQuery
   , withTransaction
-  , SqlQueryRep(..)
 
   -- * SqlQueryT monad transformer
   , SqlQueryT
   , runSqlQueryT
+  , runSqlQueryTWith
+  , SqlQueryEnv(..)
+  , mkSqlQueryEnv
 
+  -- * Transactions
+  , SqlTransaction
+  , TransactionError(..)
+
   -- * Lifted functions
   , module Database.Persist.Monad.Shim
   ) where
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO)
-import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
+import Control.Monad.Reader (ReaderT, ask, runReaderT)
 import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Resource (MonadResource)
 import Data.Acquire (withAcquire)
 import Data.Pool (Pool)
 import Data.Pool.Acquire (poolToAcquire)
-import Database.Persist.Sql (SqlBackend, runSqlConn)
+import Database.Persist.Sql (SqlBackend, SqlPersistT, runSqlConn)
+import qualified GHC.TypeLits as GHC
+import UnliftIO.Concurrent (threadDelay)
+import UnliftIO.Exception (Exception, SomeException, catchJust, throwIO)
 
+import Control.Monad.IO.Rerunnable (MonadRerunnableIO)
 import Database.Persist.Monad.Class
 import Database.Persist.Monad.Shim
 import Database.Persist.Monad.SqlQueryRep
 
+{- SqlTransaction -}
+
+-- | The monad that tracks transaction state.
+--
+-- Conceptually equivalent to 'Database.Persist.Sql.SqlPersistT', but restricts
+-- IO operations, for two reasons:
+--   1. Forking a thread that uses the same 'SqlBackend' as the current thread
+--      causes Bad Things to happen.
+--   2. Transactions may need to be retried, in which case IO operations in
+--      a transaction are required to be rerunnable.
+--
+-- You shouldn't need to explicitly use this type; your functions should only
+-- declare the 'MonadSqlQuery' constraint.
+newtype SqlTransaction m a = SqlTransaction
+  { unSqlTransaction :: SqlPersistT m a
+  }
+  deriving (Functor, Applicative, Monad, MonadRerunnableIO)
+
+instance
+  ( GHC.TypeError ('GHC.Text "Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO")
+  , Monad m
+  )
+  => MonadIO (SqlTransaction m) where
+  liftIO = undefined
+
+instance (MonadSqlQuery m, MonadUnliftIO m) => MonadSqlQuery (SqlTransaction m) where
+  type TransactionM (SqlTransaction m) = TransactionM m
+
+  runQueryRep = SqlTransaction . runSqlQueryRep
+
+  -- Delegate to 'm', since 'm' is in charge of starting/stopping transactions.
+  -- 'SqlTransaction' is ONLY in charge of executing queries.
+  withTransaction = SqlTransaction . withTransaction
+
+runSqlTransaction :: MonadUnliftIO m => SqlBackend -> SqlTransaction m a -> m a
+runSqlTransaction conn = (`runSqlConn` conn) . unSqlTransaction
+
+-- | Errors that can occur within a SQL transaction.
+data TransactionError
+  = RetryLimitExceeded
+    -- ^ The retry limit was reached when retrying a transaction.
+  deriving (Show, Eq)
+
+instance Exception TransactionError
+
 {- SqlQueryT monad -}
 
+-- | Environment to configure running 'SqlQueryT'.
+--
+-- For simple usage, you can just use 'runSqlQueryT', but for more advanced
+-- usage, including the ability to retry transactions, use 'mkSqlQueryEnv' with
+-- 'runSqlQueryTWith'.
 data SqlQueryEnv = SqlQueryEnv
   { backendPool :: Pool SqlBackend
-  , currentConn :: Maybe SqlBackend
+    -- ^ The pool for your persistent backend. Get this from @withSqlitePool@
+    -- or the equivalent for your backend.
+
+  , retryIf     :: SomeException -> Bool
+    -- ^ Retry a transaction when an exception matches this predicate. Will
+    -- retry with an exponential backoff.
+    --
+    -- Defaults to always returning False (i.e. never retry)
+
+  , retryLimit  :: Int
+    -- ^ The number of times to retry, if 'retryIf' is satisfied.
+    --
+    -- Defaults to 10.
   }
 
+-- | Build a SqlQueryEnv from the default.
+--
+-- Usage:
+--
+-- @
+-- let env = mkSqlQueryEnv pool $ \\env -> env { retryIf = 10 }
+-- in runSqlQueryTWith env m
+-- @
+mkSqlQueryEnv :: Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv
+mkSqlQueryEnv backendPool f = f SqlQueryEnv
+  { backendPool
+  , retryIf = const False
+  , retryLimit = 10
+  }
+
 -- | The monad transformer that implements 'MonadSqlQuery'.
 newtype SqlQueryT m a = SqlQueryT
   { unSqlQueryT :: ReaderT SqlQueryEnv m a
@@ -82,19 +180,28 @@
     , MonadIO
     , MonadTrans
     , MonadResource
+    , MonadRerunnableIO
     )
 
 instance MonadUnliftIO m => MonadSqlQuery (SqlQueryT m) where
-  runQueryRep queryRep = do
-    SqlQueryEnv{currentConn} <- SqlQueryT ask
-    case currentConn of
-      Just conn -> runWithConn conn
-      Nothing -> withTransactionConn runWithConn
-    where
-      runWithConn = runReaderT (runSqlQueryRep queryRep)
+  type TransactionM (SqlQueryT m) = SqlTransaction (SqlQueryT m)
 
-  withTransaction action = withTransactionConn $ \_ -> action
+  -- Running a query directly in SqlQueryT will create a one-off transaction.
+  runQueryRep = withTransaction . runQueryRep
 
+  -- Start a new transaction and run the given 'SqlTransaction'
+  withTransaction m = do
+    SqlQueryEnv{..} <- SqlQueryT ask
+    withAcquire (poolToAcquire backendPool) $ \conn ->
+      let filterRetry e = if retryIf e then Just e else Nothing
+          loop i = catchJust filterRetry (runSqlTransaction conn m) $ \_ ->
+            if i < retryLimit
+              then do
+                threadDelay $ 1000 * 2^i
+                loop $! i + 1
+              else throwIO RetryLimitExceeded
+      in loop 0
+
 instance MonadUnliftIO m => MonadUnliftIO (SqlQueryT m) where
   withRunInIO = wrappedWithRunInIO SqlQueryT unSqlQueryT
 
@@ -102,16 +209,9 @@
 
 -- | Run the 'SqlQueryT' monad transformer with the given backend.
 runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a
-runSqlQueryT backendPool = (`runReaderT` env) . unSqlQueryT
-  where
-    env = SqlQueryEnv { currentConn = Nothing, .. }
+runSqlQueryT backendPool = runSqlQueryTWith $ mkSqlQueryEnv backendPool id
 
--- | Start a new transaction and get the connection.
-withTransactionConn :: MonadUnliftIO m => (SqlBackend -> SqlQueryT m a) -> SqlQueryT m a
-withTransactionConn f = do
-  SqlQueryEnv{backendPool} <- SqlQueryT ask
-  withAcquire (poolToAcquire backendPool) $ \conn ->
-    SqlQueryT . local (setCurrentConn conn) . unSqlQueryT $
-      runSqlConn (lift $ f conn) conn
-  where
-    setCurrentConn conn env = env { currentConn = Just conn }
+-- | Run the 'SqlQueryT' monad transformer with the explicitly provided
+-- environment.
+runSqlQueryTWith :: SqlQueryEnv -> SqlQueryT m a -> m a
+runSqlQueryTWith env = (`runReaderT` env) . unSqlQueryT
diff --git a/src/Database/Persist/Monad/Class.hs b/src/Database/Persist/Monad/Class.hs
--- a/src/Database/Persist/Monad/Class.hs
+++ b/src/Database/Persist/Monad/Class.hs
@@ -6,6 +6,7 @@
 'Database.Persist.Monad.SqlQueryRep.SqlQueryRep' sent by a lifted function from
 @Database.Persist.Monad.Shim@.
 -}
+{-# LANGUAGE TypeFamilies #-}
 
 module Database.Persist.Monad.Class
   ( MonadSqlQuery(..)
@@ -22,61 +23,69 @@
 import qualified Control.Monad.Trans.State.Strict as State.Strict
 import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
 import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
+import Data.Kind (Type)
 import Data.Typeable (Typeable)
 
 import Database.Persist.Monad.SqlQueryRep (SqlQueryRep)
 
 -- | The type-class for monads that can run persistent database queries.
 class Monad m => MonadSqlQuery m where
-  -- | The main function that interprets a SQL query operation and runs it
-  -- in the monadic context.
+  type TransactionM m :: Type -> Type
+
+  -- | Interpret the given SQL query operation.
   runQueryRep :: Typeable record => SqlQueryRep record a -> m a
 
   -- | Run all queries in the given action using the same database connection.
-  --
-  -- You should make sure to not fork any threads within this action. This
-  -- will almost certainly cause problems.
-  -- https://github.com/brandonchinn178/persistent-mtl/issues/7
-  withTransaction :: m a -> m a
+  withTransaction :: TransactionM m a -> m a
 
 {- Instances for common monad transformers -}
 
 instance MonadSqlQuery m => MonadSqlQuery (Reader.ReaderT r m) where
+  type TransactionM (Reader.ReaderT r m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Reader.mapReaderT withTransaction
+  withTransaction = lift . withTransaction
 
 instance MonadSqlQuery m => MonadSqlQuery (Except.ExceptT e m) where
+  type TransactionM (Except.ExceptT e m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Except.mapExceptT withTransaction
+  withTransaction = lift . withTransaction
 
 instance MonadSqlQuery m => MonadSqlQuery (Identity.IdentityT m) where
+  type TransactionM (Identity.IdentityT m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Identity.mapIdentityT withTransaction
+  withTransaction = lift . withTransaction
 
 instance MonadSqlQuery m => MonadSqlQuery (Maybe.MaybeT m) where
+  type TransactionM (Maybe.MaybeT m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Maybe.mapMaybeT withTransaction
+  withTransaction = lift . withTransaction
 
 instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (RWS.Lazy.RWST r w s m) where
+  type TransactionM (RWS.Lazy.RWST r w s m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = RWS.Lazy.mapRWST withTransaction
+  withTransaction = lift . withTransaction
 
 instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (RWS.Strict.RWST r w s m) where
+  type TransactionM (RWS.Strict.RWST r w s m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = RWS.Strict.mapRWST withTransaction
+  withTransaction = lift . withTransaction
 
 instance MonadSqlQuery m => MonadSqlQuery (State.Lazy.StateT s m) where
+  type TransactionM (State.Lazy.StateT s m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = State.Lazy.mapStateT withTransaction
+  withTransaction = lift . withTransaction
 
 instance MonadSqlQuery m => MonadSqlQuery (State.Strict.StateT s m) where
+  type TransactionM (State.Strict.StateT s m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = State.Strict.mapStateT withTransaction
+  withTransaction = lift . withTransaction
 
 instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (Writer.Lazy.WriterT w m) where
+  type TransactionM (Writer.Lazy.WriterT w m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Writer.Lazy.mapWriterT withTransaction
+  withTransaction = lift . withTransaction
 
 instance (Monoid w, MonadSqlQuery m) => MonadSqlQuery (Writer.Strict.WriterT w m) where
+  type TransactionM (Writer.Strict.WriterT w m) = TransactionM m
   runQueryRep = lift . runQueryRep
-  withTransaction = Writer.Strict.mapWriterT withTransaction
+  withTransaction = lift . withTransaction
diff --git a/src/Database/Persist/Monad/TestUtils.hs b/src/Database/Persist/Monad/TestUtils.hs
--- a/src/Database/Persist/Monad/TestUtils.hs
+++ b/src/Database/Persist/Monad/TestUtils.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Database.Persist.Monad.TestUtils
   ( MockSqlQueryT
@@ -18,12 +19,16 @@
   , withRecord
   , mockQuery
   , MockQuery
+
   -- * Specialized helpers
   , mockSelectSource
   , mockSelectKeys
   , mockWithRawQuery
   , mockRawQuery
   , mockRawSql
+
+  -- * Re-exports
+  , SqlQueryRep(..)
   ) where
 
 import Conduit ((.|))
@@ -85,6 +90,8 @@
 runMockSqlQueryT action mockQueries = (`runReaderT` mockQueries) . unMockSqlQueryT $ action
 
 instance MonadIO m => MonadSqlQuery (MockSqlQueryT m) where
+  type TransactionM (MockSqlQueryT m) = MockSqlQueryT m
+
   runQueryRep rep = do
     mockQueries <- MockSqlQueryT ask
     maybe (error $ "Could not find mock for query: " ++ show rep) liftIO
diff --git a/test/Example.hs b/test/Example.hs
--- a/test/Example.hs
+++ b/test/Example.hs
@@ -17,6 +17,7 @@
 module Example
   ( TestApp
   , runTestApp
+  , runTestAppWith
 
     -- * Person
   , Person(..)
@@ -40,11 +41,9 @@
 
 import Control.Arrow ((&&&))
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Logger (runNoLoggingT)
 import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
-import qualified Data.Text as Text
-import Database.Persist.Sql (Entity(..), EntityField, Key, Unique, toSqlKey)
-import Database.Persist.Sqlite (withSqlitePool)
+import Database.Persist.Sql
+    (Entity(..), EntityField, Key, SelectOpt(..), Unique, toSqlKey)
 import Database.Persist.TH
     ( mkDeleteCascade
     , mkMigrate
@@ -53,9 +52,11 @@
     , share
     , sqlSettings
     )
-import UnliftIO (MonadUnliftIO(..), withSystemTempDirectory, wrappedWithRunInIO)
+import UnliftIO (MonadUnliftIO(..), wrappedWithRunInIO)
 
+import Control.Monad.IO.Rerunnable (MonadRerunnableIO)
 import Database.Persist.Monad
+import TestUtils.DB (BackendType(..), withTestDB)
 
 share
   [ mkPersist sqlSettings
@@ -96,6 +97,7 @@
     , Applicative
     , Monad
     , MonadIO
+    , MonadRerunnableIO
     , MonadSqlQuery
     , MonadResource
     )
@@ -103,15 +105,21 @@
 instance MonadUnliftIO TestApp where
   withRunInIO = wrappedWithRunInIO TestApp unTestApp
 
-runTestApp :: TestApp a -> IO a
-runTestApp m =
-  withSystemTempDirectory "persistent-mtl-testapp" $ \dir -> do
-    let db = Text.pack $ dir ++ "/db.sqlite"
-    runNoLoggingT $ withSqlitePool db 5 $ \pool ->
-      liftIO . runResourceT . runSqlQueryT pool . unTestApp $ do
-        _ <- runMigrationSilent migration
-        m
+runTestApp :: BackendType -> TestApp a -> IO a
+runTestApp backendType m =
+  withTestDB backendType $ \pool ->
+    runResourceT . runSqlQueryT pool . unTestApp $ do
+      _ <- runMigrationSilent migration
+      m
 
+runTestAppWith :: BackendType -> (SqlQueryEnv -> SqlQueryEnv) -> TestApp a -> IO a
+runTestAppWith backendType f m =
+  withTestDB backendType $ \pool -> do
+    let env = mkSqlQueryEnv pool f
+    runResourceT . runSqlQueryTWith env . unTestApp $ do
+      _ <- runMigrationSilent migration
+      m
+
 {- Person functions -}
 
 person :: String -> Person
@@ -121,7 +129,7 @@
 getName = personName . entityVal
 
 getPeople :: MonadSqlQuery m => m [Person]
-getPeople = map entityVal <$> selectList [] []
+getPeople = map entityVal <$> selectList [] [Asc PersonId]
 
 getPeopleNames :: MonadSqlQuery m => m [String]
 getPeopleNames = map personName <$> getPeople
diff --git a/test/Generated.hs b/test/Generated.hs
--- a/test/Generated.hs
+++ b/test/Generated.hs
@@ -12,9 +12,9 @@
 import Data.Map (Map)
 import Data.Text (Text)
 import Data.Void (Void)
-import Database.Persist.Sql hiding (pattern Update)
+import Database.Persist.Sql (CautiousMigration, Entity, Key, PersistValue, Sql)
 
-import Database.Persist.Monad
+import Database.Persist.Monad.TestUtils (SqlQueryRep(..))
 import Example
 
 {-# ANN module "HLint: ignore" #-}
diff --git a/test/Integration.hs b/test/Integration.hs
--- a/test/Integration.hs
+++ b/test/Integration.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -16,6 +17,7 @@
 import Data.Typeable (Typeable)
 import Database.Persist.Sql
     ( Entity(..)
+    , Migration
     , PersistField
     , PersistRecordBackend
     , PersistValue
@@ -30,68 +32,151 @@
 #endif
 import Test.Tasty
 import Test.Tasty.HUnit
-import UnliftIO (Exception, MonadIO, MonadUnliftIO, liftIO, throwIO, try)
+import UnliftIO (MonadIO, MonadUnliftIO, liftIO)
+import UnliftIO.Exception
+    ( Exception
+    , SomeException
+    , StringException(..)
+    , fromException
+    , throwIO
+    , throwString
+    , try
+    )
+import UnliftIO.IORef (atomicModifyIORef, newIORef)
 
+import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)
 import Database.Persist.Monad
 import Example
+import TestUtils.DB (BackendType(..), allBackendTypes)
 import TestUtils.Match (Match(..), (@?~))
 
 tests :: TestTree
-tests = testGroup "Integration tests"
-  [ testWithTransaction
-  , testPersistentAPI
+tests = testGroup "Integration tests" $
+  map testsWithBackend allBackendTypes
+
+testsWithBackend :: BackendType -> TestTree
+testsWithBackend backendType = testGroup (show backendType)
+  [ testWithTransaction backendType
+  , testComposability backendType
+  , testPersistentAPI backendType
   ]
 
-testWithTransaction :: TestTree
-testWithTransaction = testGroup "withTransaction"
+testWithTransaction :: BackendType -> TestTree
+testWithTransaction backendType = testGroup "withTransaction"
   [ testCase "it uses the same transaction" $ do
       -- without transactions, the INSERT shouldn't be rolled back
-      runTestApp $ do
+      runTestApp backendType $ do
         catchTestError $ insertAndFail $ person "Alice"
         result <- getPeopleNames
         liftIO $ result @?= ["Alice"]
 
       -- with transactions, the INSERT should be rolled back
-      runTestApp $ do
+      runTestApp backendType $ do
         catchTestError $ withTransaction $ insertAndFail $ person "Alice"
         result <- getPeopleNames
         liftIO $ result @?= []
+
+  , testCase "retries transactions" $ do
+      let retryIf e = case fromException e of
+            Just (StringException "retry me" _) -> True
+            _ -> False
+          setRetry env = env { retryIf, retryLimit = 5 }
+
+      counter <- newIORef (0 :: Int)
+
+      result <- try @_ @SomeException $ runTestAppWith backendType setRetry $
+        withTransaction $ rerunnableIO $ do
+          x <- atomicModifyIORef counter $ \x -> (x + 1, x)
+          if x > 2
+            then return ()
+            else throwString "retry me"
+
+      case result of
+        Right () -> return ()
+        Left e -> error $ "Got unexpected error: " ++ show e
+
+  , testCase "throws error when retry hits limit" $ do
+      let setRetry env = env { retryIf = const True, retryLimit = 2 }
+
+      result <- try @_ @TransactionError @() $ runTestAppWith backendType setRetry $
+        withTransaction $ rerunnableIO $ throwString "retry me"
+
+      result @?= Left RetryLimitExceeded
   ]
 
-testPersistentAPI :: TestTree
-testPersistentAPI = testGroup "Persistent API"
+-- this should compile
+testComposability :: BackendType -> TestTree
+testComposability backendType = testCase "Operations can be composed" $ do
+  let onlySql :: MonadSqlQuery m => m ()
+      onlySql = do
+        _ <- getPeople
+        return ()
+
+      sqlAndRerunnableIO :: (MonadSqlQuery m, MonadRerunnableIO m) => m ()
+      sqlAndRerunnableIO = do
+        _ <- getPeopleNames
+        _ <- rerunnableIO $ newIORef True
+        return ()
+
+      onlyRerunnableIO :: MonadRerunnableIO m => m ()
+      onlyRerunnableIO = do
+        _ <- rerunnableIO $ newIORef True
+        return ()
+
+      arbitraryIO :: MonadIO m => m ()
+      arbitraryIO = do
+        _ <- liftIO $ newIORef True
+        return ()
+
+  -- everything should compose naturally by default
+  runTestApp backendType $ do
+    onlySql
+    sqlAndRerunnableIO
+    onlyRerunnableIO
+    arbitraryIO
+
+  -- in a transaction, you can compose everything except arbitrary IO
+  runTestApp backendType $ withTransaction $ do
+    onlySql
+    sqlAndRerunnableIO
+    onlyRerunnableIO
+    -- uncomment this to get compile error
+    -- arbitraryIO
+
+testPersistentAPI :: BackendType -> TestTree
+testPersistentAPI backendType = testGroup "Persistent API"
   [ testCase "get" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         mapM get [1, 2]
       map (fmap personName) result @?= [Just "Alice", Nothing]
 
   , testCase "getMany" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         getMany [1]
       personName <$> Map.lookup 1 result @?= Just "Alice"
 
   , testCase "getJust" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         getJust 1
       personName result @?= "Alice"
 
   , testCase "getJustEntity" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         getJustEntity 1
       getName result @?= "Alice"
 
   , testCase "getEntity" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         mapM getEntity [1, 2]
       map (fmap getName) result @?= [Just "Alice", Nothing]
 
   , testCase "belongsTo" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         let post1 = Post "Post #1" aliceKey (Just aliceKey)
             post2 = Post "Post #2" aliceKey Nothing
@@ -100,7 +185,7 @@
       map (fmap personName) result @?= [Just "Alice", Nothing]
 
   , testCase "belongsToJust" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         let post1 = Post "Post #1" aliceKey Nothing
         insert_ post1
@@ -108,35 +193,35 @@
       personName result @?= "Alice"
 
   , testCase "insert" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         people <- getPeopleNames
         return (aliceKey, people)
       result @?= (1, ["Alice"])
 
   , testCase "insert_" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         result <- insert_ $ person "Alice"
         people <- getPeopleNames
         return (result, people)
       result @?= ((), ["Alice"])
 
   , testCase "insertMany" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         keys <- insertMany [person "Alice", person "Bob"]
         people <- getPeopleNames
         return (keys, people)
       result @?= ([1, 2], ["Alice", "Bob"])
 
   , testCase "insertMany_" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         result <- insertMany_ [person "Alice", person "Bob"]
         people <- getPeopleNames
         return (result, people)
       result @?= ((), ["Alice", "Bob"])
 
   , testCase "insertEntityMany" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         result <- insertEntityMany
           [ Entity 1 $ person "Alice"
           , Entity 2 $ person "Bob"
@@ -146,14 +231,14 @@
       result @?= ((), ["Alice", "Bob"])
 
   , testCase "insertKey" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         result <- insertKey 1 $ person "Alice"
         people <- getPeopleNames
         return (result, people)
       result @?= ((), ["Alice"])
 
   , testCase "repsert" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         repsert 1 $ alice { personAge = 100 }
@@ -165,7 +250,7 @@
         ]
 
   , testCase "repsertMany" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
 -- https://github.com/yesodweb/persistent/issues/832
 #if MIN_VERSION_persistent(2,9,0)
@@ -185,7 +270,7 @@
         ]
 
   , testCase "replace" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         replace 1 $ alice { personAge = 100 }
@@ -193,21 +278,21 @@
       personAge result @?= 100
 
   , testCase "delete" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         delete aliceKey
         getPeople
       result @?= []
 
   , testCase "update" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         key <- insert $ person "Alice"
         update key [PersonName =. "Alicia"]
         getPeopleNames
       result @?= ["Alicia"]
 
   , testCase "updateGet" $ do
-      (updateResult, getResult) <- runTestApp $ do
+      (updateResult, getResult) <- runTestApp backendType $ do
         key <- insert $ person "Alice"
         updateResult <- updateGet key [PersonName =. "Alicia"]
         getResult <- getJust key
@@ -215,34 +300,34 @@
       updateResult @?= getResult
 
   , testCase "insertEntity" $ do
-      (insertResult, getResult) <- runTestApp $ do
+      (insertResult, getResult) <- runTestApp backendType $ do
         insertResult <- insertEntity $ person "Alice"
         getResult <- getJust $ entityKey insertResult
         return (insertResult, getResult)
       entityVal insertResult @?= getResult
 
   , testCase "insertRecord" $ do
-      (insertResult, getResult) <- runTestApp $ do
+      (insertResult, getResult) <- runTestApp backendType $ do
         insertResult <- insertRecord $ person "Alice"
         getResult <- getJust 1
         return (insertResult, getResult)
       insertResult @?= getResult
 
   , testCase "getBy" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         mapM getBy [UniqueName "Alice", UniqueName "Bob"]
       map (fmap getName) result @?= [Just "Alice", Nothing]
 
   , testCase "getByValue" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         mapM getByValue [alice, person "Bob"]
       map (fmap getName) result @?= [Just "Alice", Nothing]
 
   , testCase "checkUnique" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         mapM checkUnique
@@ -254,7 +339,7 @@
 
 #if MIN_VERSION_persistent(2,11,0)
   , testCase "checkUniqueUpdateable" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         mapM checkUniqueUpdateable
@@ -266,14 +351,14 @@
 #endif
 
   , testCase "deleteBy" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         deleteBy $ UniqueName "Alice"
         getPeople
       result @?= []
 
   , testCase "insertUnique" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         result1 <- insertUnique $ person "Alice"
         result2 <- insertUnique $ person "Alice"
         people <- getPeopleNames
@@ -283,7 +368,7 @@
       people @?= ["Alice"]
 
   , testCase "upsert" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         result1 <- upsert (person "Alice") [PersonAge =. 0]
         result2 <- upsert (person "Alice") [PersonAge =. 100]
         people <- getPeople
@@ -294,7 +379,7 @@
       map nameAndAge people @?= [("Alice", 100)]
 
   , testCase "upsertBy" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         result1 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 0]
         result2 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 100]
         people <- getPeople
@@ -305,7 +390,7 @@
       map nameAndAge people @?= [("Alice", 100)]
 
   , testCase "putMany" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         let alice = person "Alice"
         insert_ alice
         putMany
@@ -319,7 +404,7 @@
         ]
 
   , testCase "insertBy" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         let alice = person "Alice"
         result1 <- insertBy alice
         result2 <- insertBy $ alice { personAge = 100 }
@@ -330,7 +415,7 @@
       map nameAndAge people @?= [("Alice", 0)]
 
   , testCase "insertUniqueEntity" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         let alice = person "Alice"
         result1 <- insertUniqueEntity alice
         result2 <- insertUniqueEntity $ alice { personAge = 100 }
@@ -341,7 +426,7 @@
       map nameAndAge people @?= [("Alice", 0)]
 
   , testCase "replaceUnique" $ do
-      (result1, result2, people) <- runTestApp $ do
+      (result1, result2, people) <- runTestApp backendType $ do
         let alice = person "Alice"
             bob = person "Bob"
         insertMany_ [alice, bob]
@@ -354,11 +439,11 @@
       map nameAndAge people @?= [("Alice", 0), ("Bob", 100)]
 
   , testCase "onlyUnique" $ do
-      result <- runTestApp $ onlyUnique $ person "Alice"
+      result <- runTestApp backendType $ onlyUnique $ person "Alice"
       result @?= UniqueName "Alice"
 
   , testCase "selectSourceRes" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         acquire <- selectSourceRes [] []
         Acquire.with acquire $ \conduit ->
@@ -366,7 +451,7 @@
       result @?= ["Alice", "Bob"]
 
   , testCase "selectFirst" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         sequence
           [ selectFirst [PersonName ==. "Alice"] []
@@ -375,7 +460,7 @@
       map (fmap getName) result @?= [Just "Alice", Nothing]
 
   , testCase "selectKeysRes" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         acquire <- selectKeysRes @_ @Person [] []
         Acquire.with acquire $ \conduit ->
@@ -383,61 +468,61 @@
       result @?= [1, 2]
 
   , testCase "count" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ $ map (\p -> p{personAge = 100}) [person "Alice", person "Bob"]
         count [PersonAge ==. 100]
       result @?= 2
 
 #if MIN_VERSION_persistent(2,11,0)
   , testCase "exists" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         exists [PersonName ==. "Alice"]
       result @?= True
 #endif
 
   , testCase "selectSource" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList
       result @?= ["Alice", "Bob"]
 
   , testCase "selectKeys" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         runConduit $ selectKeys @Person [] [] .| Conduit.sinkList
       result @?= [1, 2]
 
   , testCase "selectList" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         insert_ $ person "Bob"
         selectList [] []
       map getName result @?= ["Alice", "Bob"]
 
   , testCase "selectKeysList" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insert_ $ person "Alice"
         insert_ $ person "Bob"
         selectKeysList @Person [] []
       result @?= [1, 2]
 
   , testCase "updateWhere" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]
         getPeople
       map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]
 
   , testCase "deleteWhere" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         deleteWhere [PersonName ==. "Alice"]
         getPeopleNames
       result @?= ["Bob"]
 
   , testCase "updateWhereCount" $ do
-      (rowsUpdated, people) <- runTestApp $ do
+      (rowsUpdated, people) <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         rowsUpdated <- updateWhereCount [PersonName ==. "Alice"] [PersonAge =. 100]
         people <- getPeople
@@ -446,7 +531,7 @@
       map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]
 
   , testCase "deleteWhereCount" $ do
-      (rowsDeleted, names) <- runTestApp $ do
+      (rowsDeleted, names) <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]
         names <- getPeopleNames
@@ -455,7 +540,7 @@
       names @?= ["Bob"]
 
   , testCase "deleteCascade" $ do
-      (people, posts) <- runTestApp $ do
+      (people, posts) <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         bobKey <- insert $ person "Bob"
         insertMany_
@@ -470,7 +555,7 @@
       posts @?= ["Post #2"]
 
   , testCase "deleteCascadeWhere" $ do
-      (people, posts) <- runTestApp $ do
+      (people, posts) <- runTestApp backendType $ do
         aliceKey <- insert $ person "Alice"
         bobKey <- insert $ person "Bob"
         insertMany_
@@ -485,29 +570,37 @@
       posts @?= ["Post #2"]
 
   , testCase "parseMigration" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         setupUnsafeMigration
         parseMigration migration
-      result @?~ Right @[Text]
-        [ Match
-            ( False
-            , Text.concat
-                [ "CREATE TEMP TABLE \"person_backup\"("
-                , "\"id\" INTEGER PRIMARY KEY,"
-                , "\"name\" VARCHAR NOT NULL,"
-                , "\"age\" INTEGER NOT NULL,"
-                , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"
-                ]
-            )
-        , Anything
-        , Match (True, "DROP TABLE \"person\"")
-        , Anything
-        , Anything
-        , Match (False, "DROP TABLE \"person_backup\"")
-        ]
 
+      let sql = case backendType of
+            Sqlite ->
+              [ Match
+                  ( False
+                  , Text.concat
+                      [ "CREATE TEMP TABLE \"person_backup\"("
+                      , "\"id\" INTEGER PRIMARY KEY,"
+                      , "\"name\" VARCHAR NOT NULL,"
+                      , "\"age\" INTEGER NOT NULL,"
+                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"
+                      ]
+                  )
+              , Anything
+              , Match (True, "DROP TABLE \"person\"")
+              , Anything
+              , Anything
+              , Match (False, "DROP TABLE \"person_backup\"")
+              ]
+            Postgresql ->
+              [ Match (True, "ALTER TABLE \"person\" DROP COLUMN \"foo\"")
+              ]
+
+      result @?~ Right @[Text] sql
+
   , testCase "parseMigration'" $ do
-      let action f = runTestApp $ do
+      let action :: (Migration -> TestApp a) -> IO a
+          action f = runTestApp backendType $ do
             setupUnsafeMigration
             f migration
 
@@ -516,63 +609,77 @@
       Right result' @?= result
 
   , testCase "printMigration" $
-      runTestApp $ do
+      runTestApp backendType $ do
         setupUnsafeMigration
         printMigration migration
 
   , testCase "showMigration" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         setupUnsafeMigration
         showMigration migration
-      result @?~
-        [ Match $ Text.concat
-            [ "CREATE TEMP TABLE \"person_backup\"("
-            , "\"id\" INTEGER PRIMARY KEY,"
-            , "\"name\" VARCHAR NOT NULL,"
-            , "\"age\" INTEGER NOT NULL,"
-            , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"
-            ]
-        , Anything
-        , Match "DROP TABLE \"person\";"
-        , Anything
-        , Anything
-        , Match "DROP TABLE \"person_backup\";"
-        ]
 
+      let sql = case backendType of
+            Sqlite ->
+              [ Match $ Text.concat
+                  [ "CREATE TEMP TABLE \"person_backup\"("
+                  , "\"id\" INTEGER PRIMARY KEY,"
+                  , "\"name\" VARCHAR NOT NULL,"
+                  , "\"age\" INTEGER NOT NULL,"
+                  , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"
+                  ]
+              , Anything
+              , Match "DROP TABLE \"person\";"
+              , Anything
+              , Anything
+              , Match "DROP TABLE \"person_backup\";"
+              ]
+            Postgresql ->
+              [ Match "ALTER TABLE \"person\" DROP COLUMN \"foo\";"
+              ]
+
+      result @?~ sql
+
   , testCase "getMigration" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         setupUnsafeMigration
         getMigration migration
-      result @?~
-        [ Match $ Text.concat
-            [ "CREATE TEMP TABLE \"person_backup\"("
-            , "\"id\" INTEGER PRIMARY KEY,"
-            , "\"name\" VARCHAR NOT NULL,"
-            , "\"age\" INTEGER NOT NULL,"
-            , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"
-            ]
-        , Anything
-        , Match "DROP TABLE \"person\""
-        , Anything
-        , Anything
-        , Match "DROP TABLE \"person_backup\""
-        ]
 
+      let sql = case backendType of
+            Sqlite ->
+              [ Match $ Text.concat
+                  [ "CREATE TEMP TABLE \"person_backup\"("
+                  , "\"id\" INTEGER PRIMARY KEY,"
+                  , "\"name\" VARCHAR NOT NULL,"
+                  , "\"age\" INTEGER NOT NULL,"
+                  , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"
+                  ]
+              , Anything
+              , Match "DROP TABLE \"person\""
+              , Anything
+              , Anything
+              , Match "DROP TABLE \"person_backup\""
+              ]
+            Postgresql ->
+              [ Match "ALTER TABLE \"person\" DROP COLUMN \"foo\""
+              ]
+
+      result @?~ sql
+
   , testCase "runMigration" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         setupSafeMigration
         runMigration migration
-        getSchemaColumnNames "person"
+        getSchemaColumnNames backendType "person"
       assertNotIn "removed_column" result
 
 #if MIN_VERSION_persistent(2,10,2)
   , testCase "runMigrationQuiet" $ do
-      (withQuiet, cols) <- runTestApp $ do
+      (withQuiet, cols) <- runTestApp backendType $ do
         setupSafeMigration
         sql <- runMigrationQuiet migration
-        cols <- getSchemaColumnNames "person"
+        cols <- getSchemaColumnNames backendType "person"
         return (sql, cols)
-      withSilent <- runTestApp $ do
+      withSilent <- runTestApp backendType $ do
         setupSafeMigration
         runMigrationSilent migration
       assertNotIn "removed_column" cols
@@ -580,46 +687,46 @@
 #endif
 
   , testCase "runMigrationSilent" $ do
-      (sqlPlanned, sqlExecuted, cols) <- runTestApp $ do
+      (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do
         setupSafeMigration
         sqlPlanned <- getMigration migration
         sqlExecuted <- runMigrationSilent migration
-        cols <- getSchemaColumnNames "person"
+        cols <- getSchemaColumnNames backendType "person"
         return (sqlPlanned, sqlExecuted, cols)
       assertNotIn "removed_column" cols
       sqlExecuted @?= sqlPlanned
 
   , testCase "runMigrationUnsafe" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         setupUnsafeMigration
         runMigrationUnsafe migration
-        getSchemaColumnNames "person"
+        getSchemaColumnNames backendType "person"
       assertNotIn "removed_column" result
 
 #if MIN_VERSION_persistent(2,10,2)
   , testCase "runMigrationUnsafeQuiet" $ do
-      (sqlPlanned, sqlExecuted, cols) <- runTestApp $ do
+      (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do
         setupUnsafeMigration
         sqlPlanned <- getMigration migration
         sqlExecuted <- runMigrationUnsafeQuiet migration
-        cols <- getSchemaColumnNames "person"
+        cols <- getSchemaColumnNames backendType "person"
         return (sqlPlanned, sqlExecuted, cols)
       assertNotIn "removed_column" cols
       sqlExecuted @?= sqlPlanned
 #endif
 
   , testCase "getFieldName" $ do
-      result <- runTestApp $
+      result <- runTestApp backendType $
         getFieldName PersonName
       result @?= "\"name\""
 
   , testCase "getTableName" $ do
-      result <- runTestApp $
+      result <- runTestApp backendType $
         getTableName $ person "Alice"
       result @?= "\"person\""
 
   , testCase "withRawQuery" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         withRawQuery "SELECT name FROM person" [] $
           Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList
@@ -627,7 +734,7 @@
       result @?= ["Alice", "Bob"]
 
   , testCase "rawQueryRes" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         acquire <- rawQueryRes "SELECT name FROM person" []
         Acquire.with acquire $ \conduit ->
@@ -635,20 +742,20 @@
       result @?= ["Alice", "Bob"]
 
   , testCase "rawQuery" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.mapC (fromPersistValue' @Text . head) .| Conduit.sinkList
       result @?= ["Alice", "Bob"]
 
   , testCase "rawExecute" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         rawExecute "UPDATE person SET age = 100 WHERE name = 'Alice'" []
         getPeople
       map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]
 
   , testCase "rawExecuteCount" $ do
-      (rowsUpdated, people) <- runTestApp $ do
+      (rowsUpdated, people) <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         rowsUpdated <- rawExecuteCount "UPDATE person SET age = 100 WHERE name = 'Alice'" []
         people <- getPeople
@@ -657,20 +764,20 @@
       map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]
 
   , testCase "rawSql" $ do
-      result <- runTestApp $ do
+      result <- runTestApp backendType $ do
         insertMany_ [person "Alice", person "Bob"]
         rawSql @(Single String) "SELECT name FROM person" []
       map unSingle result @?= ["Alice", "Bob"]
 
   , testCase "transactionSave" $ do
-      result1 <- runTestApp $ do
+      result1 <- runTestApp backendType $ do
         catchTestError $ withTransaction $ do
           insert_ $ person "Alice"
           insertAndFail $ person "Bob"
         getPeopleNames
       result1 @?= []
 
-      result2 <- runTestApp $ do
+      result2 <- runTestApp backendType $ do
         catchTestError $ withTransaction $ do
           insert_ $ person "Alice"
           transactionSave
@@ -680,14 +787,14 @@
 
 #if MIN_VERSION_persistent(2,9,0)
   , testCase "transactionSaveWithIsolation" $ do
-      result1 <- runTestApp $ do
+      result1 <- runTestApp backendType $ do
         catchTestError $ withTransaction $ do
           insert_ $ person "Alice"
           insertAndFail $ person "Bob"
         getPeopleNames
       result1 @?= []
 
-      result2 <- runTestApp $ do
+      result2 <- runTestApp backendType $ do
         catchTestError $ withTransaction $ do
           insert_ $ person "Alice"
           transactionSaveWithIsolation Serializable
@@ -697,7 +804,7 @@
 #endif
 
   , testCase "transactionUndo" $ do
-      result <- runTestApp $ withTransaction $ do
+      result <- runTestApp backendType $ withTransaction $ do
         insert_ $ person "Alice"
         transactionUndo
         getPeopleNames
@@ -705,7 +812,7 @@
 
 #if MIN_VERSION_persistent(2,9,0)
   , testCase "transactionUndoWithIsolation" $ do
-      result <- runTestApp $ withTransaction $ do
+      result <- runTestApp backendType $ withTransaction $ do
         insert_ $ person "Alice"
         transactionUndoWithIsolation Serializable
         getPeopleNames
@@ -729,10 +836,15 @@
 setupUnsafeMigration = rawExecute "ALTER TABLE person ADD COLUMN foo VARCHAR" []
 
 -- | Get the names of all columns in the given table.
-getSchemaColumnNames :: MonadSqlQuery m => String -> m [String]
-getSchemaColumnNames tableName = map unSingle <$> rawSql sql []
+getSchemaColumnNames :: MonadSqlQuery m => BackendType -> String -> m [String]
+getSchemaColumnNames backendType tableName = map unSingle <$> rawSql sql []
   where
-    sql = Text.pack $ "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"
+    sql = Text.pack $ case backendType of
+      Sqlite -> "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"
+      Postgresql -> unlines
+        [ "SELECT column_name FROM information_schema.columns"
+        , "WHERE table_schema = 'public' AND table_name = '" ++ tableName ++ "'"
+        ]
 
 {- Test helpers -}
 
@@ -747,7 +859,7 @@
   liftIO $ result @?= Left TestError
 
 insertAndFail ::
-  ( MonadIO m
+  ( MonadRerunnableIO m
   , MonadSqlQuery m
   , PersistRecordBackend record SqlBackend
   , Typeable record
@@ -755,7 +867,7 @@
   => record -> m ()
 insertAndFail record = do
   insert_ record
-  throwIO TestError
+  rerunnableIO $ throwIO TestError
 
 assertNotIn :: (Eq a, Show a) => a -> [a] -> Assertion
 assertNotIn a as = as @?= filter (/= a) as
diff --git a/test/MockSqlQueryT.hs b/test/MockSqlQueryT.hs
--- a/test/MockSqlQueryT.hs
+++ b/test/MockSqlQueryT.hs
@@ -10,7 +10,6 @@
 import Test.Tasty.HUnit
 import UnliftIO (SomeException, try)
 
-import Database.Persist.Monad
 import Database.Persist.Monad.TestUtils
 import Example
 
diff --git a/test/TestUtils/DB.hs b/test/TestUtils/DB.hs
new file mode 100644
--- /dev/null
+++ b/test/TestUtils/DB.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TestUtils.DB
+  ( BackendType(..)
+  , allBackendTypes
+  , withTestDB
+  ) where
+
+import Control.Monad.Logger (runNoLoggingT)
+import qualified Data.ByteString.Char8 as Char8
+import Data.Maybe (fromMaybe)
+import Data.Pool (Pool)
+import qualified Data.Text as Text
+import Database.Persist.Postgresql (withPostgresqlPool)
+import Database.Persist.Sql (SqlBackend, rawExecute, runSqlPool)
+import Database.Persist.Sqlite (withSqlitePool)
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
+import UnliftIO (liftIO, withSystemTempDirectory)
+
+data BackendType = Sqlite | Postgresql
+  deriving (Show)
+
+allBackendTypes :: [BackendType]
+allBackendTypes = Sqlite : [Postgresql | isEnabled "TEST_POSTGRESQL"]
+  where
+    isEnabled envVarName = unsafePerformIO (lookupEnv envVarName) == Just "1"
+
+withTestDB :: BackendType -> (Pool SqlBackend -> IO a) -> IO a
+withTestDB Sqlite = withTestDBSqlite
+withTestDB Postgresql = withTestDBPostgresql
+
+withTestDBSqlite :: (Pool SqlBackend -> IO a) -> IO a
+withTestDBSqlite f =
+  withSystemTempDirectory "persistent-mtl-testapp" $ \dir -> do
+    let db = Text.pack $ dir ++ "/db.sqlite"
+    runNoLoggingT $ withSqlitePool db 5 $ \pool -> liftIO $ f pool
+
+-- Requires running database, with connection string specified in POSTGRESQL_URL
+withTestDBPostgresql :: (Pool SqlBackend -> IO a) -> IO a
+withTestDBPostgresql f = do
+  url <- fromMaybe defaultUrl <$> lookupEnv "POSTGRESQL_URL"
+  runNoLoggingT $ withPostgresqlPool (Char8.pack url) 5 $ \pool -> do
+    (`runSqlPool` pool) $
+      rawExecute "DROP SCHEMA public CASCADE; CREATE SCHEMA public;" []
+
+    liftIO $ f pool
+  where
+    defaultUrl = "postgresql://postgres@localhost/persistent_mtl"