diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,8 @@
+## 2.5
+
+* read/write typeclass split
+* add insertOrGet convenience function to PersistUnique
+
 ## 2.2.4.1
 
 * Documentation updates [#515](https://github.com/yesodweb/persistent/pull/515)
@@ -14,6 +19,7 @@
 ## 2.2.2
 
 * Add liftSqlPersistMPool function
+* support http-api-data for url serialization
 
 ## 2.2.1
 
diff --git a/Database/Persist/Class.hs b/Database/Persist/Class.hs
--- a/Database/Persist/Class.hs
+++ b/Database/Persist/Class.hs
@@ -1,15 +1,24 @@
+{-# LANGUAGE ConstraintKinds #-}
+
 module Database.Persist.Class
     ( ToBackendKey (..)
 
     -- * PersistStore
-    , PersistStore (..)
+    , PersistCore (..)
+    , PersistStore
+    , PersistStoreRead (..)
+    , PersistStoreWrite (..)
+    , BaseBackend(..)
+    , PersistRecordBackend
     , getJust
     , belongsTo
     , belongsToJust
     , insertEntity
 
     -- * PersistUnique
-    , PersistUnique (..)
+    , PersistUnique
+    , PersistUniqueRead (..)
+    , PersistUniqueWrite (..)
     , getByValue
     , insertBy
     , replaceUnique
@@ -17,7 +26,9 @@
     , onlyUnique
 
     -- * PersistQuery
-    , PersistQuery (..)
+    , PersistQuery
+    , PersistQueryRead (..)
+    , PersistQueryWrite (..)
     , selectSource
     , selectKeys
     , selectList
@@ -37,6 +48,7 @@
 
     -- * Lifting
     , HasPersistBackend (..)
+    , IsPersistBackend ()
     , liftPersist
 
     -- * JSON utilities
@@ -52,3 +64,16 @@
 import Database.Persist.Class.PersistConfig
 import Database.Persist.Class.PersistField
 import Database.Persist.Class.PersistStore
+
+
+-- | A backwards-compatible alias for those that don't care about distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well as read.
+type PersistUnique a = PersistUniqueWrite a
+
+-- | A backwards-compatible alias for those that don't care about distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well as read.
+type PersistQuery a = PersistQueryWrite a
+
+-- | A backwards-compatible alias for those that don't care about distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well as read.
+type PersistStore a = PersistStoreWrite a
diff --git a/Database/Persist/Class/DeleteCascade.hs b/Database/Persist/Class/DeleteCascade.hs
--- a/Database/Persist/Class/DeleteCascade.hs
+++ b/Database/Persist/Class/DeleteCascade.hs
@@ -18,7 +18,7 @@
 -- | For combinations of backends and entities that support
 -- cascade-deletion. “Cascade-deletion” means that entries that depend on
 -- other entries to be deleted will be deleted as well.
-class (PersistStore backend, PersistEntity record, backend ~ PersistEntityBackend record)
+class (PersistStoreWrite backend, PersistEntity record, BaseBackend backend ~ PersistEntityBackend record)
   => DeleteCascade record backend where
 
     -- | Perform cascade-deletion of single database
@@ -26,7 +26,7 @@
     deleteCascade :: MonadIO m => Key record -> ReaderT backend m ()
 
 -- | Cascade-deletion of entries satisfying given filters.
-deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, PersistQuery backend)
+deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, PersistQueryWrite backend)
                    => [Filter record] -> ReaderT backend m ()
 deleteCascadeWhere filts = do
     srcRes <- selectKeysRes filts []
diff --git a/Database/Persist/Class/PersistQuery.hs b/Database/Persist/Class/PersistQuery.hs
--- a/Database/Persist/Class/PersistQuery.hs
+++ b/Database/Persist/Class/PersistQuery.hs
@@ -1,7 +1,10 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Database.Persist.Class.PersistQuery
-    ( PersistQuery (..)
+    ( PersistQueryRead (..)
+    , PersistQueryWrite (..)
     , selectSource
     , selectKeys
     , selectList
@@ -19,51 +22,53 @@
 import Control.Monad.Trans.Resource (MonadResource, release)
 import Data.Acquire (Acquire, allocateAcquire, with)
 
--- | Backends supporting conditional operations.
-class PersistStore backend => PersistQuery backend where
-    -- | Update individual fields on any record matching the given criterion.
-    updateWhere :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-                => [Filter val] -> [Update val] -> ReaderT backend m ()
-
-    -- | Delete all records matching the given criterion.
-    deleteWhere :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-                => [Filter val] -> ReaderT backend m ()
-
+-- | Backends supporting conditional read operations.
+class (PersistCore backend, PersistStoreRead backend) => PersistQueryRead backend where
     -- | Get all records matching the given criterion in the specified order.
     -- Returns also the identifiers.
     selectSourceRes
-           :: (PersistEntity val, PersistEntityBackend val ~ backend, MonadIO m1, MonadIO m2)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> ReaderT backend m1 (Acquire (C.Source m2 (Entity val)))
+           :: (PersistRecordBackend record backend, MonadIO m1, MonadIO m2)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> ReaderT backend m1 (Acquire (C.Source m2 (Entity record)))
 
     -- | Get just the first record for the criterion.
-    selectFirst :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-                => [Filter val]
-                -> [SelectOpt val]
-                -> ReaderT backend m (Maybe (Entity val))
+    selectFirst :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record]
+                -> [SelectOpt record]
+                -> ReaderT backend m (Maybe (Entity record))
     selectFirst filts opts = do
         srcRes <- selectSourceRes filts (LimitTo 1 : opts)
         liftIO $ with srcRes (C.$$ CL.head)
 
     -- | Get the 'Key's of all records matching the given criterion.
     selectKeysRes
-        :: (MonadIO m1, MonadIO m2, PersistEntity val, backend ~ PersistEntityBackend val)
-        => [Filter val]
-        -> [SelectOpt val]
-        -> ReaderT backend m1 (Acquire (C.Source m2 (Key val)))
+        :: (MonadIO m1, MonadIO m2, PersistRecordBackend record backend)
+        => [Filter record]
+        -> [SelectOpt record]
+        -> ReaderT backend m1 (Acquire (C.Source m2 (Key record)))
 
     -- | The total number of records fulfilling the given criterion.
-    count :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-          => [Filter val] -> ReaderT backend m Int
+    count :: (MonadIO m, PersistRecordBackend record backend)
+          => [Filter record] -> ReaderT backend m Int
 
+-- | Backends supporting conditional write operations
+class (PersistQueryRead backend, PersistStoreWrite backend) => PersistQueryWrite backend where
+    -- | Update individual fields on any record matching the given criterion.
+    updateWhere :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record] -> [Update record] -> ReaderT backend m ()
+
+    -- | Delete all records matching the given criterion.
+    deleteWhere :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record] -> ReaderT backend m ()
+
 -- | Get all records matching the given criterion in the specified order.
 -- Returns also the identifiers.
 selectSource
-       :: (PersistQuery backend, MonadResource m, PersistEntity val, PersistEntityBackend val ~ backend, MonadReader env m, HasPersistBackend env backend)
-       => [Filter val]
-       -> [SelectOpt val]
-       -> C.Source m (Entity val)
+       :: (PersistQueryRead (BaseBackend backend), MonadResource m, PersistEntity record, PersistEntityBackend record ~ BaseBackend (BaseBackend backend), MonadReader backend m, HasPersistBackend backend)
+       => [Filter record]
+       -> [SelectOpt record]
+       -> C.Source m (Entity record)
 selectSource filts opts = do
     srcRes <- liftPersist $ selectSourceRes filts opts
     (releaseKey, src) <- allocateAcquire srcRes
@@ -71,10 +76,10 @@
     release releaseKey
 
 -- | Get the 'Key's of all records matching the given criterion.
-selectKeys :: (PersistQuery backend, MonadResource m, PersistEntity val, backend ~ PersistEntityBackend val, MonadReader env m, HasPersistBackend env backend)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> C.Source m (Key val)
+selectKeys :: (PersistQueryRead (BaseBackend backend), MonadResource m, PersistEntity record, BaseBackend (BaseBackend backend) ~ PersistEntityBackend record, MonadReader backend m, HasPersistBackend backend)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> C.Source m (Key record)
 selectKeys filts opts = do
     srcRes <- liftPersist $ selectKeysRes filts opts
     (releaseKey, src) <- allocateAcquire srcRes
@@ -82,19 +87,19 @@
     release releaseKey
 
 -- | Call 'selectSource' but return the result as a list.
-selectList :: (MonadIO m, PersistEntity val, PersistQuery backend, PersistEntityBackend val ~ backend)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> ReaderT backend m [Entity val]
+selectList :: (MonadIO m, PersistQueryRead backend, PersistRecordBackend record backend)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> ReaderT backend m [Entity record]
 selectList filts opts = do
     srcRes <- selectSourceRes filts opts
     liftIO $ with srcRes (C.$$ CL.consume)
 
 -- | Call 'selectKeys' but return the result as a list.
-selectKeysList :: (MonadIO m, PersistEntity val, PersistQuery backend, PersistEntityBackend val ~ backend)
-               => [Filter val]
-               -> [SelectOpt val]
-               -> ReaderT backend m [Key val]
+selectKeysList :: (MonadIO m, PersistQueryRead backend, PersistRecordBackend record backend)
+               => [Filter record]
+               -> [SelectOpt record]
+               -> ReaderT backend m [Key record]
 selectKeysList filts opts = do
     srcRes <- selectKeysRes filts opts
     liftIO $ with srcRes (C.$$ CL.consume)
diff --git a/Database/Persist/Class/PersistStore.hs b/Database/Persist/Class/PersistStore.hs
--- a/Database/Persist/Class/PersistStore.hs
+++ b/Database/Persist/Class/PersistStore.hs
@@ -1,10 +1,15 @@
 {-# LANGUAGE TypeFamilies, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE ConstraintKinds #-}
 module Database.Persist.Class.PersistStore
     ( HasPersistBackend (..)
+    , IsPersistBackend (..)
+    , PersistRecordBackend
     , liftPersist
-    , PersistStore (..)
+    , PersistCore (..)
+    , PersistStoreRead (..)
+    , PersistStoreWrite (..)
     , getJust
     , belongsTo
     , belongsToJust
@@ -22,12 +27,30 @@
 import Database.Persist.Types
 import qualified Data.Aeson as A
 
-class HasPersistBackend env backend | env -> backend where
-    persistBackend :: env -> backend
+-- | Class which allows the plucking of a @BaseBackend backend@ from some larger type.
+-- For example,
+-- @
+-- instance HasPersistBackend (SqlReadBackend, Int) where
+--   type BaseBackend (SqlReadBackend, Int) = SqlBackend
+--   persistBackend = unSqlReadBackend . fst
+-- @
+class HasPersistBackend backend where
+    type BaseBackend backend
+    persistBackend :: backend -> BaseBackend backend
+-- | Class which witnesses that @backend@ is essentially the same as @BaseBackend backend@.
+-- That is, they're isomorphic and @backend@ is just some wrapper over @BaseBackend backend@.
+class (HasPersistBackend backend) => IsPersistBackend backend where
+    -- | This function is how we actually construct and tag a backend as having read or write capabilities.
+    -- It should be used carefully and only when actually constructing a @backend@. Careless use allows us
+    -- to accidentally run a write query against a read-only database.
+    mkPersistBackend :: BaseBackend backend -> backend
 
-liftPersist :: (MonadReader env m, HasPersistBackend env backend, MonadIO m)
-            => ReaderT backend IO a
-            -> m a
+-- | A convenient alias for common type signatures
+type PersistRecordBackend record backend = (PersistEntity record, PersistEntityBackend record ~ BaseBackend backend)
+
+liftPersist
+    :: (MonadIO m, MonadReader backend m, HasPersistBackend backend)
+    => ReaderT (BaseBackend backend) IO b -> m b
 liftPersist f = do
     env <- ask
     liftIO $ runReaderT f (persistBackend env)
@@ -43,31 +66,40 @@
 -- 'ToBackendKey'.
 class ( PersistEntity record
       , PersistEntityBackend record ~ backend
-      , PersistStore backend
+      , PersistCore backend
       ) => ToBackendKey backend record where
     toBackendKey   :: Key record -> BackendKey backend
     fromBackendKey :: BackendKey backend -> Key record
 
+class PersistCore backend where
+    data BackendKey backend
+
 class
   ( Show (BackendKey backend), Read (BackendKey backend)
   , Eq (BackendKey backend), Ord (BackendKey backend)
+  , PersistCore backend
   , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), A.FromJSON (BackendKey backend)
-  ) => PersistStore backend where
-    data BackendKey backend
-
+  ) => PersistStoreRead backend where
     -- | Get a record by identifier, if available.
-    get :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-        => Key val -> ReaderT backend m (Maybe val)
+    get :: (MonadIO m, PersistRecordBackend record backend)
+        => Key record -> ReaderT backend m (Maybe record)
 
+class
+  ( Show (BackendKey backend), Read (BackendKey backend)
+  , Eq (BackendKey backend), Ord (BackendKey backend)
+  , PersistStoreRead backend
+  , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), A.FromJSON (BackendKey backend)
+  ) => PersistStoreWrite backend where
+
     -- | Create a new record in the database, returning an automatically created
     -- key (in SQL an auto-increment id).
-    insert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-           => val -> ReaderT backend m (Key val)
+    insert :: (MonadIO m, PersistRecordBackend record backend)
+           => record -> ReaderT backend m (Key record)
 
     -- | Same as 'insert', but doesn't return a @Key@.
-    insert_ :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-            => val -> ReaderT backend m ()
-    insert_ val = insert val >> return ()
+    insert_ :: (MonadIO m, PersistRecordBackend record backend)
+            => record -> ReaderT backend m ()
+    insert_ record = insert record >> return ()
 
     -- | Create multiple records in the database and return their 'Key's.
     --
@@ -78,16 +110,16 @@
     --
     -- The SQLite and MySQL backends use the slow, default implementation of
     -- @mapM insert@.
-    insertMany :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-               => [val] -> ReaderT backend m [Key val]
+    insertMany :: (MonadIO m, PersistRecordBackend record backend)
+               => [record] -> ReaderT backend m [Key record]
     insertMany = mapM insert
 
     -- | Same as 'insertMany', but doesn't return any 'Key's.
     --
     -- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in
     -- one database query.
-    insertMany_ :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-                => [val] -> ReaderT backend m ()
+    insertMany_ :: (MonadIO m, PersistRecordBackend record backend)
+                => [record] -> ReaderT backend m ()
     insertMany_ x = insertMany x >> return ()
 
     -- | Same as 'insertMany_', but takes an 'Entity' instead of just a record.
@@ -99,43 +131,43 @@
     --
     -- The SQL backends use the slow, default implementation of
     -- @mapM_ insertKey@.
-    insertEntityMany :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-                     => [Entity val] -> ReaderT backend m ()
+    insertEntityMany :: (MonadIO m, PersistRecordBackend record backend)
+                     => [Entity record] -> ReaderT backend m ()
     insertEntityMany = mapM_ (\(Entity k record) -> insertKey k record)
 
     -- | Create a new record in the database using the given key.
-    insertKey :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-              => Key val -> val -> ReaderT backend m ()
+    insertKey :: (MonadIO m, PersistRecordBackend record backend)
+              => Key record -> record -> ReaderT backend m ()
 
     -- | Put the record in the database with the given key.
     -- Unlike 'replace', if a record with the given key does not
     -- exist then a new record will be inserted.
-    repsert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-            => Key val -> val -> ReaderT backend m ()
+    repsert :: (MonadIO m, PersistRecordBackend record backend)
+            => Key record -> record -> ReaderT backend m ()
 
     -- | Replace the record in the database with the given
     -- key. Note that the result is undefined if such record does
     -- not exist, so you must use 'insertKey or 'repsert' in
     -- these cases.
-    replace :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-            => Key val -> val -> ReaderT backend m ()
+    replace :: (MonadIO m, PersistRecordBackend record backend)
+            => Key record -> record -> ReaderT backend m ()
 
     -- | Delete a specific record by identifier. Does nothing if record does
     -- not exist.
-    delete :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-           => Key val -> ReaderT backend m ()
+    delete :: (MonadIO m, PersistRecordBackend record backend)
+           => Key record -> ReaderT backend m ()
 
     -- | Update individual fields on a specific record.
-    update :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-           => Key val -> [Update val] -> ReaderT backend m ()
+    update :: (MonadIO m, PersistRecordBackend record backend)
+           => Key record -> [Update record] -> ReaderT backend m ()
 
     -- | Update individual fields on a specific record, and retrieve the
     -- updated value from the database.
     --
     -- Note that this function will throw an exception if the given key is not
     -- found in the database.
-    updateGet :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-              => Key val -> [Update val] -> ReaderT backend m val
+    updateGet :: (MonadIO m, PersistRecordBackend record backend)
+              => Key record -> [Update record] -> ReaderT backend m record
     updateGet key ups = do
         update key ups
         get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return
@@ -143,12 +175,11 @@
 
 -- | Same as get, but for a non-null (not Maybe) foreign key
 -- Unsafe unless your database is enforcing that the foreign key is valid.
-getJust :: ( PersistStore backend
-           , PersistEntity val
-           , Show (Key val)
-           , backend ~ PersistEntityBackend val
+getJust :: ( PersistStoreRead backend
+           , Show (Key record)
+           , PersistRecordBackend record backend
            , MonadIO m
-           ) => Key val -> ReaderT backend m val
+           ) => Key record -> ReaderT backend m record
 getJust key = get key >>= maybe
   (liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key)
   return
@@ -157,10 +188,9 @@
 --
 -- > foreign = belongsTo foreignId
 belongsTo ::
-  ( PersistStore backend
+  ( PersistStoreRead backend
   , PersistEntity ent1
-  , PersistEntity ent2
-  , backend ~ PersistEntityBackend ent2
+  , PersistRecordBackend ent2 backend
   , MonadIO m
   ) => (ent1 -> Maybe (Key ent2)) -> ent1 -> ReaderT backend m (Maybe ent2)
 belongsTo foreignKeyField model = case foreignKeyField model of
@@ -169,10 +199,9 @@
 
 -- | Same as 'belongsTo', but uses @getJust@ and therefore is similarly unsafe.
 belongsToJust ::
-  ( PersistStore backend
+  ( PersistStoreRead backend
   , PersistEntity ent1
-  , PersistEntity ent2
-  , backend ~ PersistEntityBackend ent2
+  , PersistRecordBackend ent2 backend
   , MonadIO m
   )
   => (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2
@@ -180,9 +209,8 @@
 
 -- | Like @insert@, but returns the complete @Entity@.
 insertEntity ::
-    ( PersistStore backend
-    , PersistEntity e
-    , backend ~ PersistEntityBackend e
+    ( PersistStoreWrite backend
+    , PersistRecordBackend e backend
     , MonadIO m
     ) => e -> ReaderT backend m (Entity e)
 insertEntity e = do
diff --git a/Database/Persist/Class/PersistUnique.hs b/Database/Persist/Class/PersistUnique.hs
--- a/Database/Persist/Class/PersistUnique.hs
+++ b/Database/Persist/Class/PersistUnique.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
 module Database.Persist.Class.PersistUnique
-    ( PersistUnique (..)
+    ( PersistUniqueRead (..)
+    , PersistUniqueWrite (..)
     , getByValue
     , insertBy
     , replaceUnique
@@ -35,7 +36,11 @@
 -- you must manually place a unique index on a field to have a uniqueness
 -- constraint.
 --
--- Some functions in this module ('insertUnique', 'insertBy', and
+class (PersistCore backend, PersistStoreRead backend) => PersistUniqueRead backend where
+    -- | Get a record by unique key, if available. Returns also the identifier.
+    getBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record -> ReaderT backend m (Maybe (Entity record))
+
+-- | Some functions in this module ('insertUnique', 'insertBy', and
 -- 'replaceUnique') first query the unique indexes to check for
 -- conflicts. You could instead optimistically attempt to perform the
 -- operation (e.g. 'replace' instead of 'replaceUnique'). However,
@@ -44,17 +49,15 @@
 --  determing the column of failure;
 --
 --  * an exception will automatically abort the current SQL transaction.
-class PersistStore backend => PersistUnique backend where
-    -- | Get a record by unique key, if available. Returns also the identifier.
-    getBy :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val) => Unique val -> ReaderT backend m (Maybe (Entity val))
+class (PersistUniqueRead backend, PersistStoreWrite backend) => PersistUniqueWrite backend where
 
     -- | Delete a specific record by unique key. Does nothing if no record
     -- matches.
-    deleteBy :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val) => Unique val -> ReaderT backend m ()
+    deleteBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record -> ReaderT backend m ()
 
     -- | Like 'insert', but returns 'Nothing' when the record
     -- couldn't be inserted because of a uniqueness constraint.
-    insertUnique :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val) => val -> ReaderT backend m (Maybe (Key val))
+    insertUnique :: (MonadIO m, PersistRecordBackend record backend) => record -> ReaderT backend m (Maybe (Key record))
     insertUnique datum = do
         conflict <- checkUnique datum
         case conflict of
@@ -67,13 +70,13 @@
     -- * update the existing record that matches the uniqueness contraint.
     --
     -- Throws an exception if there is more than 1 uniqueness contraint.
-    upsert :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val)
-           => val          -- ^ new record to insert
-           -> [Update val]
+    upsert :: (MonadIO m, PersistRecordBackend record backend)
+           => record          -- ^ new record to insert
+           -> [Update record]
            -- ^ updates to perform if the record already exists (leaving
            -- this empty is the equivalent of performing a 'repsert' on a
            -- unique key)
-           -> ReaderT backend m (Entity val)
+           -> ReaderT backend m (Entity record)
            -- ^ the record in the database after the operation
     upsert record updates = do
         uniqueKey <- onlyUnique record
@@ -89,22 +92,33 @@
 -- | Insert a value, checking for conflicts with any unique constraints.  If a
 -- duplicate exists in the database, it is returned as 'Left'. Otherwise, the
 -- new 'Key is returned as 'Right'.
-insertBy :: (MonadIO m, PersistEntity val, PersistUnique backend, PersistEntityBackend val ~ backend)
-         => val -> ReaderT backend m (Either (Entity val) (Key val))
+insertBy :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend record backend)
+         => record -> ReaderT backend m (Either (Entity record) (Key record))
 insertBy val = do
     res <- getByValue val
     case res of
       Nothing -> Right `liftM` insert val
       Just z -> return $ Left z
 
+-- | Insert a value, checking for conflicts with any unique constraints. If a
+-- duplicate exists in the database, it is left untouched. The key of the
+-- existing or new entry is returned
+insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend record backend)
+            => record -> ReaderT backend m (Key record)
+insertOrGet val = do
+    res <- getByValue val
+    case res of
+        Nothing -> insert val
+        Just (Entity key _) -> return key
+
 -- | Return the single unique key for a record.
-onlyUnique :: (MonadIO m, PersistEntity val, PersistUnique backend, PersistEntityBackend val ~ backend)
-           => val -> ReaderT backend m (Unique val)
+onlyUnique :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend record backend)
+           => record -> ReaderT backend m (Unique record)
 onlyUnique record = case onlyUniqueEither record of
     Right u -> return u
     Left us -> requireUniques record us >>= liftIO . throwIO . OnlyUniqueException . show . length
 
-onlyUniqueEither :: (PersistEntity val) => val -> Either [Unique val] (Unique val)
+onlyUniqueEither :: (PersistEntity record) => record -> Either [Unique record] (Unique record)
 onlyUniqueEither record = case persistUniqueKeys record of
     [u] -> Right u
     us  -> Left us
@@ -113,7 +127,7 @@
 -- of a 'Unique' record. Returns a record matching /one/ of the unique keys. This
 -- function makes the most sense on entities with a single 'Unique'
 -- constructor.
-getByValue :: (MonadIO m, PersistEntity record, PersistUnique backend, PersistEntityBackend record ~ backend)
+getByValue :: (MonadIO m, PersistUniqueRead backend, PersistRecordBackend record backend)
            => record -> ReaderT backend m (Maybe (Entity record))
 getByValue record = checkUniques =<< requireUniques record (persistUniqueKeys record)
   where
@@ -142,7 +156,7 @@
 -- If uniqueness is violated, return a 'Just' with the 'Unique' violation
 --
 -- Since 1.2.2.0
-replaceUnique :: (MonadIO m, Eq record, Eq (Unique record), PersistEntityBackend record ~ backend, PersistEntity record, PersistUnique backend)
+replaceUnique :: (MonadIO m, Eq record, Eq (Unique record), PersistRecordBackend record backend, PersistUniqueWrite backend)
               => Key record -> record -> ReaderT backend m (Maybe (Unique record))
 replaceUnique key datumNew = getJust key >>= replaceOriginal
   where
@@ -161,11 +175,11 @@
 --
 -- Returns 'Nothing' if the entity would be unique, and could thus safely be inserted.
 -- on a conflict returns the conflicting key
-checkUnique :: (MonadIO m, PersistEntityBackend record ~ backend, PersistEntity record, PersistUnique backend)
+checkUnique :: (MonadIO m, PersistRecordBackend record backend, PersistUniqueRead backend)
             => record -> ReaderT backend m (Maybe (Unique record))
 checkUnique = checkUniqueKeys . persistUniqueKeys
 
-checkUniqueKeys :: (MonadIO m, PersistEntity record, PersistUnique backend, PersistEntityBackend record ~ backend)
+checkUniqueKeys :: (MonadIO m, PersistEntity record, PersistUniqueRead backend, PersistRecordBackend record backend)
                 => [Unique record] -> ReaderT backend m (Maybe (Unique record))
 checkUniqueKeys [] = return Nothing
 checkUniqueKeys (x:xs) = do
diff --git a/Database/Persist/Sql/Class.hs b/Database/Persist/Sql/Class.hs
--- a/Database/Persist/Sql/Class.hs
+++ b/Database/Persist/Sql/Class.hs
@@ -4,7 +4,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
 #ifndef NO_OVERLAP
 {-# LANGUAGE OverlappingInstances #-}
 #endif
@@ -58,15 +60,18 @@
     rawSqlProcessRow [pv]  = Single <$> fromPersistValue pv
     rawSqlProcessRow _     = Left $ pack "RawSql (Single a): wrong number of columns."
 
-instance (PersistEntity a, PersistEntityBackend a ~ SqlBackend) => RawSql (Key a) where
-  rawSqlCols _ key         = (length $ keyToValues key, [])
-  rawSqlColCountReason key = "The primary key is composed of "
-                             ++ (show $ length $ keyToValues key)
-                             ++ " columns"
-  rawSqlProcessRow         = keyFromValues
+instance
+    (PersistEntity a, PersistEntityBackend a ~ backend, IsPersistBackend backend) =>
+    RawSql (Key a) where
+    rawSqlCols _ key         = (length $ keyToValues key, [])
+    rawSqlColCountReason key = "The primary key is composed of "
+                               ++ (show $ length $ keyToValues key)
+                               ++ " columns"
+    rawSqlProcessRow         = keyFromValues
 
-instance (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
-         => RawSql (Entity record) where
+instance
+    (PersistEntity record, PersistEntityBackend record ~ backend, IsPersistBackend backend) =>
+    RawSql (Entity record) where
     rawSqlCols escape ent = (length sqlFields, [intercalate ", " sqlFields])
         where
           sqlFields = map (((name <> ".") <>) . escape)
diff --git a/Database/Persist/Sql/Orphan/PersistQuery.hs b/Database/Persist/Sql/Orphan/PersistQuery.hs
--- a/Database/Persist/Sql/Orphan/PersistQuery.hs
+++ b/Database/Persist/Sql/Orphan/PersistQuery.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -20,7 +21,7 @@
 import Data.Monoid (Monoid (..), (<>))
 import Data.Int (Int64)
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader (ReaderT, ask)
+import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT)
 import Control.Exception (throwIO)
 import qualified Data.Conduit.List as CL
 import Data.Conduit
@@ -29,7 +30,7 @@
 import Data.List (transpose, inits, find)
 
 -- orphaned instance for convenience of modularity
-instance PersistQuery SqlBackend where
+instance PersistQueryRead SqlBackend where
     count filts = do
         conn <- ask
         let wher = if null filts
@@ -123,24 +124,33 @@
             case keyFromValues keyvals of
                 Right k -> return k
                 Left _ -> error "selectKeysImpl: keyFromValues failed"
-
-
+instance PersistQueryRead SqlReadBackend where
+    count filts = withReaderT persistBackend $ count filts
+    selectSourceRes filts opts = withReaderT persistBackend $ selectSourceRes filts opts
+    selectKeysRes filts opts = withReaderT persistBackend $ selectKeysRes filts opts
+instance PersistQueryRead SqlWriteBackend where
+    count filts = withReaderT persistBackend $ count filts
+    selectSourceRes filts opts = withReaderT persistBackend $ selectSourceRes filts opts
+    selectKeysRes filts opts = withReaderT persistBackend $ selectKeysRes filts opts
 
+instance PersistQueryWrite SqlBackend where
     deleteWhere filts = do
         _ <- deleteWhereCount filts
         return ()
-
     updateWhere filts upds = do
         _ <- updateWhereCount filts upds
         return ()
+instance PersistQueryWrite SqlWriteBackend where
+    deleteWhere filts = withReaderT persistBackend $ deleteWhere filts
+    updateWhere filts upds = withReaderT persistBackend $ updateWhere filts upds
 
 -- | Same as 'deleteWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlBackend)
+deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ SqlBackend, IsSqlBackend backend)
                  => [Filter val]
-                 -> ReaderT SqlBackend m Int64
-deleteWhereCount filts = do
+                 -> ReaderT backend m Int64
+deleteWhereCount filts = withReaderT persistBackend $ do
     conn <- ask
     let t = entityDef $ dummyFromFilts filts
     let wher = if null filts
@@ -156,12 +166,12 @@
 -- | Same as 'updateWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val)
+updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val, IsSqlBackend backend)
                  => [Filter val]
                  -> [Update val]
-                 -> ReaderT SqlBackend m Int64
+                 -> ReaderT backend m Int64
 updateWhereCount _ [] = return 0
-updateWhereCount filts upds = do
+updateWhereCount filts upds = withReaderT persistBackend $ do
     conn <- ask
     let wher = if null filts
                 then ""
diff --git a/Database/Persist/Sql/Orphan/PersistStore.hs b/Database/Persist/Sql/Orphan/PersistStore.hs
--- a/Database/Persist/Sql/Orphan/PersistStore.hs
+++ b/Database/Persist/Sql/Orphan/PersistStore.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -30,7 +31,7 @@
 import Data.ByteString.Char8 (readInteger)
 import Data.Maybe (isJust)
 import Data.List (find)
-import Control.Monad.Trans.Reader (ReaderT, ask)
+import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT)
 import Data.Acquire (with)
 import Data.Int (Int64)
 import Web.PathPieces (PathPiece)
@@ -68,20 +69,18 @@
 --
 -- Your backend may provide a more convenient tableName function
 -- which does not operate in a Monad
-getTableName :: forall record m.
+getTableName :: forall record m backend.
              ( PersistEntity record
              , PersistEntityBackend record ~ SqlBackend
+             , IsSqlBackend backend
              , Monad m
-             ) => record -> ReaderT SqlBackend m Text
-getTableName rec = do
+             ) => record -> ReaderT backend m Text
+getTableName rec = withReaderT persistBackend $ do
     conn <- ask
     return $ connEscapeName conn $ tableDBName rec
 
 -- | useful for a backend to implement tableName by adding escaping
-tableDBName :: forall record.
-            ( PersistEntity record
-            , PersistEntityBackend record ~ SqlBackend
-            ) => record -> DBName
+tableDBName :: (PersistEntity record) => record -> DBName
 tableDBName rec = entityDB $ entityDef (Just rec)
 
 -- | get the SQL string for the field that an EntityField represents
@@ -89,13 +88,14 @@
 --
 -- Your backend may provide a more convenient fieldName function
 -- which does not operate in a Monad
-getFieldName :: forall record typ m.
+getFieldName :: forall record typ m backend.
              ( PersistEntity record
              , PersistEntityBackend record ~ SqlBackend
+             , IsSqlBackend backend
              , Monad m
              )
-             => EntityField record typ -> ReaderT SqlBackend m Text
-getFieldName rec = do
+             => EntityField record typ -> ReaderT backend m Text
+getFieldName rec = withReaderT persistBackend $ do
     conn <- ask
     return $ connEscapeName conn $ fieldDBName rec
 
@@ -104,10 +104,17 @@
 fieldDBName = fieldDB . persistFieldDef
 
 
-instance PersistStore SqlBackend where
+instance PersistCore SqlBackend where
     newtype BackendKey SqlBackend = SqlBackendKey { unSqlBackendKey :: Int64 }
         deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, Bounded, A.ToJSON, A.FromJSON)
+instance PersistCore SqlReadBackend where
+    newtype BackendKey SqlReadBackend = SqlReadBackendKey { unSqlReadBackendKey :: Int64 }
+        deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, Bounded, A.ToJSON, A.FromJSON)
+instance PersistCore SqlWriteBackend where
+    newtype BackendKey SqlWriteBackend = SqlWriteBackendKey { unSqlWriteBackendKey :: Int64 }
+        deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, Bounded, A.ToJSON, A.FromJSON)
 
+instance PersistStoreWrite SqlBackend where
     update _ [] = return ()
     update k upds = do
         conn <- ask
@@ -247,6 +254,29 @@
           Nothing -> insertKey key value
           Just _ -> replace key value
 
+    delete k = do
+        conn <- ask
+        rawExecute (sql conn) (keyToValues k)
+      where
+        wher conn = whereStmtForKey conn k
+        sql conn = T.concat
+            [ "DELETE FROM "
+            , connEscapeName conn $ tableDBName $ recordTypeFromKey k
+            , " WHERE "
+            , wher conn
+            ]
+instance PersistStoreWrite SqlWriteBackend where
+    insert v = withReaderT persistBackend $ insert v
+    insertMany vs = withReaderT persistBackend $ insertMany vs
+    insertMany_ vs = withReaderT persistBackend $ insertMany_ vs
+    insertKey k v = withReaderT persistBackend $ insertKey k v
+    repsert k v = withReaderT persistBackend $ repsert k v
+    replace k v = withReaderT persistBackend $ replace k v
+    delete k = withReaderT persistBackend $ delete k
+    update k upds = withReaderT persistBackend $ update k upds
+
+
+instance PersistStoreRead SqlBackend where
     get k = do
         conn <- ask
         let t = entityDef $ dummyFromKey k
@@ -271,18 +301,10 @@
                     case fromPersistValues $ if noColumns then [] else vals of
                         Left e -> error $ "get " ++ show k ++ ": " ++ unpack e
                         Right v -> return $ Just v
-
-    delete k = do
-        conn <- ask
-        rawExecute (sql conn) (keyToValues k)
-      where
-        wher conn = whereStmtForKey conn k
-        sql conn = T.concat
-            [ "DELETE FROM "
-            , connEscapeName conn $ tableDBName $ recordTypeFromKey k
-            , " WHERE "
-            , wher conn
-            ]
+instance PersistStoreRead SqlReadBackend where
+    get k = withReaderT persistBackend $ get k
+instance PersistStoreRead SqlWriteBackend where
+    get k = withReaderT persistBackend $ get k
 
 dummyFromKey :: Key record -> Maybe record
 dummyFromKey = Just . recordTypeFromKey
diff --git a/Database/Persist/Sql/Orphan/PersistUnique.hs b/Database/Persist/Sql/Orphan/PersistUnique.hs
--- a/Database/Persist/Sql/Orphan/PersistUnique.hs
+++ b/Database/Persist/Sql/Orphan/PersistUnique.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Database.Persist.Sql.Orphan.PersistUnique () where
 
 import Control.Exception (throwIO)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Persist
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Raw
@@ -12,9 +15,9 @@
 import qualified Data.Text as T
 import Data.Monoid (mappend)
 import qualified Data.Conduit.List as CL
-import Control.Monad.Trans.Reader (ask)
+import Control.Monad.Trans.Reader (ask, withReaderT)
 
-instance PersistUnique SqlBackend where
+instance PersistUniqueWrite SqlBackend where
     deleteBy uniq = do
         conn <- ask
         let sql' = sql conn
@@ -30,7 +33,10 @@
             , " WHERE "
             , T.intercalate " AND " $ map (go' conn) $ go uniq
             ]
+instance PersistUniqueWrite SqlWriteBackend where
+    deleteBy uniq = withReaderT persistBackend $ deleteBy uniq
 
+instance PersistUniqueRead SqlBackend where
     getBy uniq = do
         conn <- ask
         let sql = T.concat
@@ -56,6 +62,10 @@
         go conn x = connEscapeName conn x `mappend` "=?"
         t = entityDef $ dummyFromUnique uniq
         toFieldNames' = map snd . persistUniqueToFieldNames
+instance PersistUniqueRead SqlReadBackend where
+    getBy uniq = withReaderT persistBackend $ getBy uniq
+instance PersistUniqueRead SqlWriteBackend where
+    getBy uniq = withReaderT persistBackend $ getBy uniq
 
 dummyFromUnique :: Unique v -> Maybe v
 dummyFromUnique _ = Nothing
diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
--- a/Database/Persist/Sql/Raw.hs
+++ b/Database/Persist/Sql/Raw.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 module Database.Persist.Sql.Raw where
 
 import Database.Persist
@@ -9,6 +11,7 @@
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Reader (ReaderT, ask, MonadReader)
 import Data.Acquire (allocateAcquire, Acquire, mkAcquire, with)
+import Data.Functor ((<$>))
 import Data.IORef (writeIORef, readIORef, newIORef)
 import Control.Exception (throwIO)
 import Control.Monad (when, liftM)
@@ -19,7 +22,7 @@
 import Data.Conduit
 import Control.Monad.Trans.Resource (MonadResource,release)
 
-rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env SqlBackend)
+rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env, BaseBackend env ~ SqlBackend)
          => Text
          -> [PersistValue]
          -> Source m [PersistValue]
@@ -30,12 +33,12 @@
     release releaseKey
 
 rawQueryRes
-    :: (MonadIO m1, MonadIO m2)
+    :: (MonadIO m1, MonadIO m2, IsSqlBackend env)
     => Text
     -> [PersistValue]
-    -> ReaderT SqlBackend m1 (Acquire (Source m2 [PersistValue]))
+    -> ReaderT env m1 (Acquire (Source m2 [PersistValue]))
 rawQueryRes sql vals = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     let make = do
             runLoggingT (logDebugNS (pack "SQL") $ T.append sql $ pack $ "; " ++ show vals)
                 (connLogFunc conn)
@@ -53,12 +56,12 @@
 
 -- | Execute a raw SQL statement and return the number of
 -- rows it has modified.
-rawExecuteCount :: MonadIO m
+rawExecuteCount :: (MonadIO m, IsSqlBackend backend)
                 => Text            -- ^ SQL statement, possibly with placeholders.
                 -> [PersistValue]  -- ^ Values to fill the placeholders.
-                -> ReaderT SqlBackend m Int64
+                -> ReaderT backend m Int64
 rawExecuteCount sql vals = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     runLoggingT (logDebugNS (pack "SQL") $ T.append sql $ pack $ "; " ++ show vals)
         (connLogFunc conn)
     stmt <- getStmt sql
@@ -66,9 +69,11 @@
     liftIO $ stmtReset stmt
     return res
 
-getStmt :: MonadIO m => Text -> ReaderT SqlBackend m Statement
+getStmt
+  :: (MonadIO m, IsSqlBackend backend)
+  => Text -> ReaderT backend m Statement
 getStmt sql = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     liftIO $ getStmtConn conn sql
 
 getStmtConn :: SqlBackend -> Text -> IO Statement
diff --git a/Database/Persist/Sql/Run.hs b/Database/Persist/Sql/Run.hs
--- a/Database/Persist/Sql/Run.hs
+++ b/Database/Persist/Sql/Run.hs
@@ -1,7 +1,10 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Database.Persist.Sql.Run where
 
+import Database.Persist.Class.PersistStore
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Raw
 import Control.Monad.Trans.Control
@@ -24,7 +27,9 @@
 -- Note: This function previously timed out after 2 seconds, but this behavior
 -- was buggy and caused more problems than it solved. Since version 2.1.2, it
 -- performs no timeout checks.
-runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool SqlBackend -> m a
+runSqlPool
+    :: (MonadBaseControl IO m, IsSqlBackend backend)
+    => ReaderT backend m a -> Pool backend -> m a
 runSqlPool r pconn = withResource pconn $ runSqlConn r
 
 -- | Like 'withResource', but times out the operation if resource
@@ -49,37 +54,46 @@
             return ret
 {-# INLINABLE withResourceTimeout #-}
 
-runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> SqlBackend -> m a
+runSqlConn :: (MonadBaseControl IO m, IsSqlBackend backend) => ReaderT backend m a -> backend -> m a
 runSqlConn r conn = control $ \runInIO -> mask $ \restore -> do
-    let getter = getStmtConn conn
-    restore $ connBegin conn getter
+    let conn' = persistBackend conn
+        getter = getStmtConn conn'
+    restore $ connBegin conn' getter
     x <- onException
             (restore $ runInIO $ runReaderT r conn)
-            (restore $ connRollback conn getter)
-    restore $ connCommit conn getter
+            (restore $ connRollback conn' getter)
+    restore $ connCommit conn' getter
     return x
 
-runSqlPersistM :: SqlPersistM a -> SqlBackend -> IO a
+runSqlPersistM
+    :: (IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> backend -> IO a
 runSqlPersistM x conn = runResourceT $ runNoLoggingT $ runSqlConn x conn
 
-runSqlPersistMPool :: SqlPersistM a -> Pool SqlBackend -> IO a
+runSqlPersistMPool
+    :: (IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> Pool backend -> IO a
 runSqlPersistMPool x pool = runResourceT $ runNoLoggingT $ runSqlPool x pool
 
-liftSqlPersistMPool :: MonadIO m => SqlPersistM a -> Pool SqlBackend -> m a
+liftSqlPersistMPool
+    :: (MonadIO m, IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> Pool backend -> m a
 liftSqlPersistMPool x pool = liftIO (runSqlPersistMPool x pool)
 
-withSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
-            => (LogFunc -> IO SqlBackend) -- ^ create a new connection
-            -> Int -- ^ connection count
-            -> (Pool SqlBackend -> m a)
-            -> m a
-withSqlPool mkConn connCount f = do
+withSqlPool
+    :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)
+    => (LogFunc -> IO backend) -- ^ create a new connection
+    -> Int -- ^ connection count
+    -> (Pool backend -> m a)
+    -> m a
+withSqlPool mkConn connCount f =
     bracket (createSqlPool mkConn connCount) (liftIO . destroyAllResources) f
 
-createSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
-              => (LogFunc -> IO SqlBackend)
-              -> Int
-              -> m (Pool SqlBackend)
+createSqlPool
+    :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)
+    => (LogFunc -> IO backend)
+    -> Int
+    -> m (Pool backend)
 createSqlPool mkConn size = do
     logFunc <- askLogFunc
     liftIO $ createPool (mkConn logFunc) close' 1 20 size
@@ -99,13 +113,14 @@
         _ <- runInBase (monadLoggerLog a b c d)
         return ()
 
-withSqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
-            => (LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a
+withSqlConn
+    :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend)
+    => (LogFunc -> IO backend) -> (backend -> m a) -> m a
 withSqlConn open f = do
     logFunc <- askLogFunc
     bracket (liftIO $ open logFunc) (liftIO . close') f
 
-close' :: SqlBackend -> IO ()
+close' :: (IsSqlBackend backend) => backend -> IO ()
 close' conn = do
-    readIORef (connStmtMap conn) >>= mapM_ stmtFinalize . Map.elems
-    connClose conn
+    readIORef (connStmtMap $ persistBackend conn) >>= mapM_ stmtFinalize . Map.elems
+    connClose $ persistBackend conn
diff --git a/Database/Persist/Sql/Types.hs b/Database/Persist/Sql/Types.hs
--- a/Database/Persist/Sql/Types.hs
+++ b/Database/Persist/Sql/Types.hs
@@ -1,13 +1,21 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-module Database.Persist.Sql.Types where
+module Database.Persist.Sql.Types
+    ( module Database.Persist.Sql.Types
+    , SqlBackend (..), SqlReadBackend (..), SqlWriteBackend (..)
+    , Statement (..), LogFunc, InsertSqlResult (..)
+    , readToUnknown, readToWrite, writeToUnknown
+    , SqlBackendCanRead, SqlBackendCanWrite, SqlReadT, SqlWriteT, IsSqlBackend
+    ) where
 
 import Control.Exception (Exception)
 import Control.Monad.Trans.Resource (ResourceT)
@@ -18,7 +26,7 @@
 import Control.Monad.Trans.Writer (WriterT)
 import Data.Typeable (Typeable)
 import Database.Persist.Types
-import Database.Persist.Class (HasPersistBackend (..))
+import Database.Persist.Sql.Types.Internal
 import Data.IORef (IORef)
 import Data.Map (Map)
 import Data.Int (Int64)
@@ -29,49 +37,9 @@
 import System.Log.FastLogger (LogStr)
 import Data.Text (Text)
 
-data InsertSqlResult = ISRSingle Text
-                     | ISRInsertGet Text Text
-                     | ISRManyKeys Text [PersistValue]
-
 -- | Deprecated synonym for @SqlBackend@.
 type Connection = SqlBackend
 {-# DEPRECATED Connection "Please use SqlBackend instead" #-}
-
-data SqlBackend = SqlBackend
-    { connPrepare :: Text -> IO Statement
-    -- | table name, column names, id name, either 1 or 2 statements to run
-    , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
-    , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult) -- ^ SQL for inserting many rows and returning their primary keys, for backends that support this functioanlity. If 'Nothing', rows will be inserted one-at-a-time using 'connInsertSql'.
-    , connStmtMap :: IORef (Map Text Statement)
-    , connClose :: IO ()
-    , connMigrateSql
-        :: [EntityDef]
-        -> (Text -> IO Statement)
-        -> EntityDef
-        -> IO (Either [Text] [(Bool, Text)])
-    , connBegin :: (Text -> IO Statement) -> IO ()
-    , connCommit :: (Text -> IO Statement) -> IO ()
-    , connRollback :: (Text -> IO Statement) -> IO ()
-    , connEscapeName :: DBName -> Text
-    , connNoLimit :: Text
-    , connRDBMS :: Text
-    , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
-    , connLogFunc :: LogFunc
-    }
-    deriving Typeable
-instance HasPersistBackend SqlBackend SqlBackend where
-    persistBackend = id
-
-type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
-
-data Statement = Statement
-    { stmtFinalize :: IO ()
-    , stmtReset :: IO ()
-    , stmtExecute :: [PersistValue] -> IO Int64
-    , stmtQuery :: forall m. MonadIO m
-                => [PersistValue]
-                -> Acquire (Source m [PersistValue])
-    }
 
 data Column = Column
     { cName      :: !DBName
diff --git a/Database/Persist/Sql/Types/Internal.hs b/Database/Persist/Sql/Types/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Database/Persist/Sql/Types/Internal.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Database.Persist.Sql.Types.Internal
+    ( HasPersistBackend (..)
+    , IsPersistBackend (..)
+    , SqlReadBackend (unSqlReadBackend)
+    , SqlWriteBackend (unSqlWriteBackend)
+    , readToUnknown
+    , readToWrite
+    , writeToUnknown
+    , LogFunc
+    , InsertSqlResult (..)
+    , Statement (..)
+    , SqlBackend (..)
+    , SqlBackendCanRead
+    , SqlBackendCanWrite
+    , SqlReadT
+    , SqlWriteT
+    , IsSqlBackend
+    ) where
+
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Logger (LogSource, LogLevel)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
+import Data.Acquire (Acquire)
+import Data.Conduit (Source)
+import Data.Int (Int64)
+import Data.IORef (IORef)
+import Data.Map (Map)
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Database.Persist.Class
+  ( HasPersistBackend (..)
+  , PersistQueryRead, PersistQueryWrite
+  , PersistStoreRead, PersistStoreWrite
+  , PersistUniqueRead, PersistUniqueWrite
+  )
+import Database.Persist.Class.PersistStore (IsPersistBackend (..))
+import Database.Persist.Types
+import Language.Haskell.TH.Syntax (Loc)
+import System.Log.FastLogger (LogStr)
+
+type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
+
+data InsertSqlResult = ISRSingle Text
+                     | ISRInsertGet Text Text
+                     | ISRManyKeys Text [PersistValue]
+
+data Statement = Statement
+    { stmtFinalize :: IO ()
+    , stmtReset :: IO ()
+    , stmtExecute :: [PersistValue] -> IO Int64
+    , stmtQuery :: forall m. MonadIO m
+                => [PersistValue]
+                -> Acquire (Source m [PersistValue])
+    }
+
+data SqlBackend = SqlBackend
+    { connPrepare :: Text -> IO Statement
+    -- | table name, column names, id name, either 1 or 2 statements to run
+    , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
+    , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult) -- ^ SQL for inserting many rows and returning their primary keys, for backends that support this functioanlity. If 'Nothing', rows will be inserted one-at-a-time using 'connInsertSql'.
+    , connStmtMap :: IORef (Map Text Statement)
+    , connClose :: IO ()
+    , connMigrateSql
+        :: [EntityDef]
+        -> (Text -> IO Statement)
+        -> EntityDef
+        -> IO (Either [Text] [(Bool, Text)])
+    , connBegin :: (Text -> IO Statement) -> IO ()
+    , connCommit :: (Text -> IO Statement) -> IO ()
+    , connRollback :: (Text -> IO Statement) -> IO ()
+    , connEscapeName :: DBName -> Text
+    , connNoLimit :: Text
+    , connRDBMS :: Text
+    , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
+    , connLogFunc :: LogFunc
+    }
+    deriving Typeable
+instance HasPersistBackend SqlBackend where
+    type BaseBackend SqlBackend = SqlBackend
+    persistBackend = id
+instance IsPersistBackend SqlBackend where
+    mkPersistBackend = id
+
+-- | An SQL backend which can only handle read queries
+newtype SqlReadBackend = SqlReadBackend { unSqlReadBackend :: SqlBackend } deriving Typeable
+instance HasPersistBackend SqlReadBackend where
+    type BaseBackend SqlReadBackend = SqlBackend
+    persistBackend = unSqlReadBackend
+instance IsPersistBackend SqlReadBackend where
+    mkPersistBackend = SqlReadBackend
+
+-- | An SQL backend which can handle read or write queries
+newtype SqlWriteBackend = SqlWriteBackend { unSqlWriteBackend :: SqlBackend } deriving Typeable
+instance HasPersistBackend SqlWriteBackend where
+    type BaseBackend SqlWriteBackend = SqlBackend
+    persistBackend = unSqlWriteBackend
+instance IsPersistBackend SqlWriteBackend where
+    mkPersistBackend = SqlWriteBackend
+
+-- | Useful for running a write query against an untagged backend with unknown capabilities.
+writeToUnknown :: Monad m => ReaderT SqlWriteBackend m a -> ReaderT SqlBackend m a
+writeToUnknown ma = do
+  unknown <- ask
+  lift . runReaderT ma $ SqlWriteBackend unknown
+
+-- | Useful for running a read query against a backend with read and write capabilities.
+readToWrite :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlWriteBackend m a
+readToWrite ma = do
+  write <- ask
+  lift . runReaderT ma . SqlReadBackend $ unSqlWriteBackend write
+
+-- | Useful for running a read query against a backend with unknown capabilities.
+readToUnknown :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlBackend m a
+readToUnknown ma = do
+  unknown <- ask
+  lift . runReaderT ma $ SqlReadBackend unknown
+
+-- | A constraint synonym which witnesses that a backend is SQL and can run read queries.
+type SqlBackendCanRead backend =
+  ( IsSqlBackend backend
+  , PersistQueryRead backend, PersistStoreRead backend, PersistUniqueRead backend
+  )
+-- | A constraint synonym which witnesses that a backend is SQL and can run read and write queries.
+type SqlBackendCanWrite backend =
+  ( SqlBackendCanRead backend
+  , PersistQueryWrite backend, PersistStoreWrite backend, PersistUniqueWrite backend
+  )
+-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle read queries.
+type SqlReadT m a = forall backend. (SqlBackendCanRead backend) => ReaderT backend m a
+-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle read and write queries.
+type SqlWriteT m a = forall backend. (SqlBackendCanWrite backend) => ReaderT backend m a
+-- | A backend which is a wrapper around @SqlBackend@.
+type IsSqlBackend backend = (IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
diff --git a/persistent.cabal b/persistent.cabal
--- a/persistent.cabal
+++ b/persistent.cabal
@@ -1,5 +1,5 @@
 name:            persistent
-version:         2.2.4.1
+version:         2.5
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -60,6 +60,7 @@
                      Database.Persist.Class
                      Database.Persist.Sql
                      Database.Persist.Sql.Util
+                     Database.Persist.Sql.Types.Internal
 
     other-modules:   Database.Persist.Types.Base
                      Database.Persist.Class.DeleteCascade