diff --git a/Database/Persist/Class.hs b/Database/Persist/Class.hs
--- a/Database/Persist/Class.hs
+++ b/Database/Persist/Class.hs
@@ -11,9 +11,13 @@
     , getByValue
     , insertBy
     , replaceUnique
+    , checkUnique
+    , onlyUnique
 
     -- * PersistQuery
     , PersistQuery (..)
+    , selectSource
+    , selectKeys
     , selectList
     , selectKeysList
 
@@ -27,6 +31,10 @@
     , PersistField (..)
     -- * PersistConfig
     , PersistConfig (..)
+
+    -- * Lifting
+    , HasPersistBackend (..)
+    , liftPersist
 
     -- * JSON utilities
     , keyValueEntityToJSON, keyValueEntityFromJSON
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
@@ -11,10 +11,17 @@
 
 import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Reader (ReaderT, ask, runReaderT)
+import Data.Acquire (with)
 
-class (PersistStore m, PersistEntity a, PersistEntityBackend a ~ PersistMonadBackend m) => DeleteCascade a m where
-    deleteCascade :: Key a -> m ()
+class (PersistStore backend, PersistEntity record, backend ~ PersistEntityBackend record)
+  => DeleteCascade record backend where
+    deleteCascade :: MonadIO m => Key record -> ReaderT backend m ()
 
-deleteCascadeWhere :: (DeleteCascade a m, PersistQuery m)
-                   => [Filter a] -> m ()
-deleteCascadeWhere filts = selectKeys filts [] C.$$ CL.mapM_ deleteCascade
+deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, PersistQuery backend)
+                   => [Filter record] -> ReaderT backend m ()
+deleteCascadeWhere filts = do
+    srcRes <- selectKeysRes filts []
+    conn <- ask
+    liftIO $ with srcRes (C.$$ CL.mapM_ (flip runReaderT conn . deleteCascade))
diff --git a/Database/Persist/Class/PersistEntity.hs b/Database/Persist/Class/PersistEntity.hs
--- a/Database/Persist/Class/PersistEntity.hs
+++ b/Database/Persist/Class/PersistEntity.hs
@@ -2,13 +2,14 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts, StandaloneDeriving, UndecidableInstances #-}
 module Database.Persist.Class.PersistEntity
     ( PersistEntity (..)
     , Update (..)
+    , BackendSpecificUpdate
     , SelectOpt (..)
-    , BackendSpecificFilter
     , Filter (..)
-    , Key
+    , BackendSpecificFilter
     , Entity (..)
 
     , keyValueEntityToJSON, keyValueEntityFromJSON
@@ -36,35 +37,45 @@
 --
 -- Some advanced type system capabilities are used to make this process type-safe.
 -- Persistent users usually don't need to understand the class associated data and functions.
-class PersistEntity record where
-    -- | An 'EntityField' is parameterised by the Haskell record it belongs to
-    -- and the additional type of that field
-    data EntityField record :: * -> *
-
-    -- | return meta-data for a given 'EntityField'
-    persistFieldDef :: EntityField record typ -> FieldDef SqlType
-
-    -- | Persistent allows multiple different backends
+class ( PersistField (Key record), ToJSON (Key record), FromJSON (Key record)
+      , Show (Key record), Read (Key record), Eq (Key record), Ord (Key record))
+  => PersistEntity record where
+    -- | Persistent allows multiple different backends (databases)
     type PersistEntityBackend record
 
-    -- | Unique keys besided the Key
-    data Unique record
+    -- | By default, a backend will automatically generate the key
+    -- Instead you can specify a Primary key made up of unique values.
+    data Key record
+    -- | a lower-level key operation
+    keyToValues :: Key record -> [PersistValue]
+    -- | a lower-level key operation
+    keyFromValues :: [PersistValue] -> Either Text (Key record)
+    -- | a meta-operation to retrieve the Key EntityField
+    persistIdField :: EntityField record (Key record)
 
     -- | retrieve the EntityDef meta-data for the record
-    entityDef :: Monad m => m record -> EntityDef SqlType
+    entityDef :: Monad m => m record -> EntityDef
 
-    -- | Get the database fields of a record
+    -- | An 'EntityField' is parameterised by the Haskell record it belongs to
+    -- and the additional type of that field
+    data EntityField record :: * -> *
+    -- | return meta-data for a given 'EntityField'
+    persistFieldDef :: EntityField record typ -> FieldDef
+    -- | A meta-operation to get the database fields of a record
     toPersistFields :: record -> [SomePersistField]
-
-    -- | Convert from database values to a Haskell record
+    -- | A lower-level operation to convert from database values to a Haskell record
     fromPersistValues :: [PersistValue] -> Either Text record
 
+    -- | Unique keys besided the Key
+    data Unique record
+    -- | A meta operation to retrieve all the Unique keys
+    persistUniqueKeys :: record -> [Unique record]
+    -- | A lower level operation
     persistUniqueToFieldNames :: Unique record -> [(HaskellName, DBName)]
+    -- | A lower level operation
     persistUniqueToValues :: Unique record -> [PersistValue]
-    persistUniqueKeys :: record -> [Unique record]
 
-    persistIdField :: EntityField record (Key record)
-
+    -- | Use a PersistField as a lens
     fieldLens :: EntityField record field
               -> (forall f. Functor f => (field -> f field) -> Entity record -> f (Entity record))
 
@@ -108,11 +119,6 @@
     | BackendFilter
           (BackendSpecificFilter (PersistEntityBackend record) record)
 
--- | Helper wrapper, equivalent to @Key (PersistEntityBackend val) val@.
---
--- Since 1.1.0
-type Key record = KeyBackend (PersistEntityBackend record) record
-
 -- | Datatype that represents an entity, with both its 'Key' and
 -- its Haskell record representation.
 --
@@ -143,11 +149,15 @@
 -- your query returns two entities (i.e. @(Entity backend a,
 -- Entity backend b)@), then you must you use @SELECT ??, ??
 -- WHERE ...@, and so on.
-data Entity entity =
-    Entity { entityKey :: Key entity
-           , entityVal :: entity }
-    deriving (Eq, Ord, Show, Read)
+data PersistEntity record => Entity record =
+    Entity { entityKey :: Key record
+           , entityVal :: record }
 
+deriving instance (PersistEntity record, Eq (Key record), Eq record) => Eq (Entity record)
+deriving instance (PersistEntity record, Ord (Key record), Ord record) => Ord (Entity record)
+deriving instance (PersistEntity record, Show (Key record), Show record) => Show (Entity record)
+deriving instance (PersistEntity record, Read (Key record), Read record) => Read (Entity record)
+
 -- | Predefined @toJSON@. The resulting JSON looks like
 -- @{\"key\": 1, \"value\": {\"name\": ...}}@.
 --
@@ -157,7 +167,8 @@
 --   instance ToJSON User where
 --       toJSON = keyValueEntityToJSON
 -- @
-keyValueEntityToJSON :: ToJSON e => Entity e -> Value
+keyValueEntityToJSON :: (PersistEntity record, ToJSON record, ToJSON (Key record))
+                     => Entity record -> Value
 keyValueEntityToJSON (Entity key value) = object
     [ "key" .= key
     , "value" .= value
@@ -172,7 +183,8 @@
 --   instance FromJSON User where
 --       parseJSON = keyValueEntityFromJSON
 -- @
-keyValueEntityFromJSON :: FromJSON e => Value -> Parser (Entity e)
+keyValueEntityFromJSON :: (PersistEntity record, FromJSON record, FromJSON (Key record))
+                       => Value -> Parser (Entity record)
 keyValueEntityFromJSON (Object o) = Entity
     <$> o .: "key"
     <*> o .: "value"
@@ -187,7 +199,7 @@
 --   instance ToJSON User where
 --       toJSON = entityIdToJSON
 -- @
-entityIdToJSON :: ToJSON e => Entity e -> Value
+entityIdToJSON :: (PersistEntity record, ToJSON record, ToJSON (Key record)) => Entity record -> Value
 entityIdToJSON (Entity key value) = case toJSON value of
     Object o -> Object $ HM.insert "id" (toJSON key) o
     x -> x
@@ -201,21 +213,22 @@
 --   instance FromJSON User where
 --       parseJSON = entityIdFromJSON
 -- @
-entityIdFromJSON :: FromJSON e => Value -> Parser (Entity e)
+entityIdFromJSON :: (PersistEntity record, FromJSON record, FromJSON (Key record)) => Value -> Parser (Entity record)
 entityIdFromJSON value@(Object o) = Entity <$> o .: "id" <*> parseJSON value
 entityIdFromJSON _ = fail "entityIdFromJSON: not an object"
 
-instance PersistField entity => PersistField (Entity entity) where
+instance (PersistEntity record, PersistField record, PersistField (Key record))
+  => PersistField (Entity record) where
     toPersistValue (Entity key value) = case toPersistValue value of
         (PersistMap alist) -> PersistMap ((idField, toPersistValue key) : alist)
         _ -> error $ T.unpack $ errMsg "expected PersistMap"
 
     fromPersistValue (PersistMap alist) = case after of
         [] -> Left $ errMsg $ "did not find " `mappend` idField `mappend` " field"
-        ("_id", k):afterRest ->
-            case fromPersistValue (PersistMap (before ++ afterRest)) of
-                Right record -> Right $ Entity (Key k) record
-                Left err     -> Left err
+        ("_id", kv):afterRest ->
+            fromPersistValue (PersistMap (before ++ afterRest)) >>= \record ->
+                keyFromValues [kv] >>= \k ->
+                    Right (Entity k record)
         _ -> Left $ errMsg $ "impossible id field: " `mappend` T.pack (show alist)
       where
         (before, after) = break ((== idField) . fst) alist
diff --git a/Database/Persist/Class/PersistField.hs b/Database/Persist/Class/PersistField.hs
--- a/Database/Persist/Class/PersistField.hs
+++ b/Database/Persist/Class/PersistField.hs
@@ -19,7 +19,6 @@
 #ifdef HIGH_PRECISION_DATE
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 #endif
-import Data.Time.LocalTime (ZonedTime)
 import Data.ByteString.Char8 (ByteString, unpack, readInt)
 import Control.Applicative
 import Data.Int (Int8, Int16, Int32, Int64)
@@ -47,6 +46,7 @@
 import qualified Data.Map as M
 
 import qualified Data.Text.Encoding as TE
+import qualified Data.Vector as V
 
 -- | A value which can be marshalled to and from a 'PersistValue'.
 class PersistField a where
@@ -65,7 +65,6 @@
     fromPersistValue (PersistDay d) = Right $ Prelude.show d
     fromPersistValue (PersistTimeOfDay d) = Right $ Prelude.show d
     fromPersistValue (PersistUTCTime d) = Right $ Prelude.show d
-    fromPersistValue (PersistZonedTime (ZT z)) = Right $ Prelude.show z
     fromPersistValue PersistNull = Left $ T.pack "Unexpected null"
     fromPersistValue (PersistBool b) = Right $ Prelude.show b
     fromPersistValue (PersistList _) = Left $ T.pack "Cannot convert PersistList to String"
@@ -81,7 +80,7 @@
 
 instance PersistField T.Text where
     toPersistValue = PersistText
-    fromPersistValue = either (Left . T.pack) Right . fromPersistValueText
+    fromPersistValue = fromPersistValueText
 
 instance PersistField TL.Text where
     toPersistValue = toPersistValue . TL.toStrict
@@ -230,19 +229,6 @@
 
     fromPersistValue x = Left $ T.pack $ "Expected UTCTime, received: " ++ show x
 
-instance PersistField ZonedTime where
-    toPersistValue = PersistZonedTime . ZT
-    fromPersistValue (PersistZonedTime (ZT z)) = Right z
-    fromPersistValue x@(PersistText t) =
-        case reads $ T.unpack t of
-            (z, _):_ -> Right z
-            _ -> Left $ T.pack $ "Expected ZonedTime, received " ++ show x
-    fromPersistValue x@(PersistByteString s) =
-        case reads $ unpack s of
-            (z, _):_ -> Right z
-            _ -> Left $ T.pack $ "Expected ZonedTime, received " ++ show x
-    fromPersistValue x = Left $ T.pack $ "Expected ZonedTime, received: " ++ show x
-
 instance PersistField a => PersistField (Maybe a) where
     toPersistValue Nothing = PersistNull
     toPersistValue (Just a) = toPersistValue a
@@ -260,6 +246,11 @@
     fromPersistValue (PersistNull) = Right []
     fromPersistValue x = Left $ T.pack $ "Expected PersistList, received: " ++ show x
 
+instance PersistField a => PersistField (V.Vector a) where
+  toPersistValue = toPersistValue . V.toList
+  fromPersistValue = either (\e -> Left ("Vector: " `T.append` e))
+                            (Right . V.fromList) . fromPersistValue
+
 instance (Ord a, PersistField a) => PersistField (S.Set a) where
     toPersistValue = PersistList . map toPersistValue . S.toList
     fromPersistValue (PersistList list) =
@@ -286,8 +277,6 @@
 instance PersistField PersistValue where
     toPersistValue = id
     fromPersistValue = Right
-
-deriving instance PersistField (KeyBackend backend entity)
 
 fromPersistList :: PersistField a => [PersistValue] -> Either T.Text [a]
 fromPersistList = mapM fromPersistValue
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
@@ -2,136 +2,99 @@
 {-# LANGUAGE TypeFamilies #-}
 module Database.Persist.Class.PersistQuery
     ( PersistQuery (..)
+    , selectSource
+    , selectKeys
     , selectList
     , selectKeysList
     ) where
 
-import Control.Exception (throwIO)
 import Database.Persist.Types
-
-import Control.Monad.Trans.Error (Error (..))
-
-import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.Monoid (Monoid)
-
-import Data.Conduit.Internal (Pipe, ConduitM)
-import Control.Monad.Logger (LoggingT)
-import Control.Monad.Trans.Identity ( IdentityT)
-import Control.Monad.Trans.List     ( ListT    )
-import Control.Monad.Trans.Maybe    ( MaybeT   )
-import Control.Monad.Trans.Error    ( ErrorT   )
-
-#if MIN_VERSION_transformers(0,4,0)
-import Control.Monad.Trans.Except   ( ExceptT  )
-#endif
-
-import Control.Monad.Trans.Reader   ( ReaderT  )
-import Control.Monad.Trans.Cont     ( ContT  )
-import Control.Monad.Trans.State    ( StateT   )
-import Control.Monad.Trans.Writer   ( WriterT  )
-import Control.Monad.Trans.RWS      ( RWST     )
-import Control.Monad.Trans.Resource ( ResourceT)
+import Control.Monad.Reader   ( ReaderT, MonadReader  )
 
-import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
-import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
-import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
 import Database.Persist.Class.PersistStore
 import Database.Persist.Class.PersistEntity
-
-class PersistStore m => PersistQuery m where
-    -- | Update individual fields on a specific record.
-    update :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
-           => Key val -> [Update val] -> 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 :: (PersistEntity val, PersistMonadBackend m ~ PersistEntityBackend val)
-              => Key val -> [Update val] -> m val
-    updateGet key ups = do
-        update key ups
-        get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Resource (MonadResource, release)
+import Data.Acquire (Acquire, mkAcquire, allocateAcquire, with)
 
+class PersistStore backend => PersistQuery backend where
     -- | Update individual fields on any record matching the given criterion.
-    updateWhere :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
-                => [Filter val] -> [Update val] -> m ()
+    updateWhere :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+                => [Filter val] -> [Update val] -> ReaderT backend m ()
 
     -- | Delete all records matching the given criterion.
-    deleteWhere :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
-                => [Filter val] -> m ()
+    deleteWhere :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+                => [Filter val] -> ReaderT backend m ()
 
     -- | Get all records matching the given criterion in the specified order.
     -- Returns also the identifiers.
-    selectSource
-           :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
+    selectSourceRes
+           :: (PersistEntity val, PersistEntityBackend val ~ backend, MonadIO m1, MonadIO m2)
            => [Filter val]
            -> [SelectOpt val]
-           -> C.Source m (Entity val)
+           -> ReaderT backend m1 (Acquire (C.Source m2 (Entity val)))
 
     -- | get just the first record for the criterion
-    selectFirst :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
+    selectFirst :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
                 => [Filter val]
                 -> [SelectOpt val]
-                -> m (Maybe (Entity val))
-    selectFirst filts opts = selectSource filts ((LimitTo 1):opts) C.$$ CL.head
-
+                -> ReaderT backend m (Maybe (Entity val))
+    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.
-    selectKeys :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
-               => [Filter val]
-               -> [SelectOpt val]
-               -> C.Source m (Key val)
+    selectKeysRes
+        :: (MonadIO m1, MonadIO m2, PersistEntity val, backend ~ PersistEntityBackend val)
+        => [Filter val]
+        -> [SelectOpt val]
+        -> ReaderT backend m1 (Acquire (C.Source m2 (Key val)))
 
     -- | The total number of records fulfilling the given criterion.
-    count :: (PersistEntity val, PersistEntityBackend val ~ PersistMonadBackend m)
-          => [Filter val] -> m Int
+    count :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+          => [Filter val] -> ReaderT backend m Int
 
+-- | 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)
+selectSource filts opts = do
+    srcRes <- liftPersist $ selectSourceRes filts opts
+    (releaseKey, src) <- allocateAcquire srcRes
+    src
+    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 filts opts = do
+    srcRes <- liftPersist $ selectKeysRes filts opts
+    (releaseKey, src) <- allocateAcquire srcRes
+    src
+    release releaseKey
+
 -- | Call 'selectSource' but return the result as a list.
-selectList :: (PersistEntity val, PersistQuery m, PersistEntityBackend val ~ PersistMonadBackend m)
+selectList :: (MonadIO m, PersistEntity val, PersistQuery backend, PersistEntityBackend val ~ backend)
            => [Filter val]
            -> [SelectOpt val]
-           -> m [Entity val]
-selectList a b = selectSource a b C.$$ CL.consume
+           -> ReaderT backend m [Entity val]
+selectList filts opts = do
+    srcRes <- selectSourceRes filts opts
+    liftIO $ with srcRes (C.$$ CL.consume)
 
 -- | Call 'selectKeys' but return the result as a list.
-selectKeysList :: (PersistEntity val, PersistQuery m, PersistEntityBackend val ~ PersistMonadBackend m)
+selectKeysList :: (MonadIO m, PersistEntity val, PersistQuery backend, PersistEntityBackend val ~ backend)
                => [Filter val]
                -> [SelectOpt val]
-               -> m [Key val]
-selectKeysList a b = selectKeys a b C.$$ CL.consume
-
-
-#define DEF(T) { update k = lift . update k; updateGet k = lift . updateGet k; updateWhere f = lift . updateWhere f; deleteWhere = lift . deleteWhere; selectSource f = C.transPipe lift . selectSource f; selectFirst f = lift . selectFirst f; selectKeys f = C.transPipe lift . selectKeys f; count = lift . count }
-#define GO(T) instance (PersistQuery m) => PersistQuery (T m) where DEF(T)
-#define GOX(X, T) instance (X, PersistQuery m) => PersistQuery (T m) where DEF(T)
-
-GO(LoggingT)
-GO(IdentityT)
-GO(ListT)
-GO(MaybeT)
-GOX(Error e, ErrorT e)
-
-#if MIN_VERSION_transformers(0,4,0)
-GO(ExceptT e)
-#endif
-
-GO(ReaderT r)
-GO(ContT r)
-GO(StateT s)
-GO(ResourceT)
-GO(Pipe l i o u)
-GO(ConduitM i o)
-GOX(Monoid w, WriterT w)
-GOX(Monoid w, RWST r w s)
-GOX(Monoid w, Strict.RWST r w s)
-GO(Strict.StateT s)
-GOX(Monoid w, Strict.WriterT w)
-
-#undef DEF
-#undef GO
-#undef GOX
+               -> ReaderT backend m [Key val]
+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,7 +1,12 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
 module Database.Persist.Class.PersistStore
-    ( PersistStore (..)
+    ( HasPersistBackend (..)
+    , liftPersist
+    , PersistStore (..)
     , getJust
     , belongsTo
     , belongsToJust
@@ -13,85 +18,107 @@
 import qualified Data.Text as T
 
 import Control.Monad.Trans.Error (Error (..))
-import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.Monoid (Monoid)
 import Control.Exception.Lifted (throwIO)
 
 import Data.Conduit.Internal (Pipe, ConduitM)
-import Control.Monad.Logger (LoggingT)
-import Control.Monad.Trans.Identity ( IdentityT)
-import Control.Monad.Trans.List     ( ListT    )
-import Control.Monad.Trans.Maybe    ( MaybeT   )
-import Control.Monad.Trans.Error    ( ErrorT   )
 
-#if MIN_VERSION_transformers(0,4,0)
-import Control.Monad.Trans.Except   ( ExceptT  )
-#endif
-
 import Control.Monad.Trans.Reader   ( ReaderT  )
-import Control.Monad.Trans.Cont     ( ContT  )
-import Control.Monad.Trans.State    ( StateT   )
-import Control.Monad.Trans.Writer   ( WriterT  )
-import Control.Monad.Trans.RWS      ( RWST     )
-import Control.Monad.Trans.Resource ( ResourceT)
+import Control.Monad.Reader (MonadReader (ask), runReaderT)
 
-import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
-import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
-import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 
 import Database.Persist.Class.PersistEntity
+import Database.Persist.Class.PersistField
 import Database.Persist.Types
+import qualified Data.Aeson as A
 
-class MonadIO m => PersistStore m where
-    type PersistMonadBackend m
+class HasPersistBackend env backend | env -> backend where
+    persistBackend :: env -> backend
 
+liftPersist :: (MonadReader env m, HasPersistBackend env backend, MonadIO m)
+            => ReaderT backend IO a
+            -> m a
+liftPersist f = do
+    env <- ask
+    liftIO $ runReaderT f (persistBackend env)
+
+class
+  ( Show (BackendKey backend), Read (BackendKey backend)
+  , Eq (BackendKey backend), Ord (BackendKey backend)
+  , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), A.FromJSON (BackendKey backend)
+  ) => PersistStore backend where
+    data BackendKey backend
+
+    backendKeyToValues :: BackendKey backend -> [PersistValue]
+    backendKeyFromValues :: [PersistValue] -> Either T.Text (BackendKey backend)
+
     -- | Get a record by identifier, if available.
-    get :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-        => Key val -> m (Maybe val)
+    get :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+        => Key val -> ReaderT backend m (Maybe val)
 
     -- | Create a new record in the database, returning an automatically created
     -- key (in SQL an auto-increment id).
-    insert :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-           => val -> m (Key val)
+    insert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+           => val -> ReaderT backend m (Key val)
 
     -- | Same as 'insert', but doesn't return a @Key@.
-    insert_ :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-            => val -> m ()
+    insert_ :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+            => val -> ReaderT backend m ()
     insert_ val = insert val >> return ()
 
     -- | Create multiple records in the database.
     -- SQL backends currently use the slow default implementation of
     -- @mapM insert@
-    insertMany :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-                => [val] -> m [Key val]
+    insertMany :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+               => [val] -> ReaderT backend m [Key val]
     insertMany = mapM insert
 
     -- | Create a new record in the database using the given key.
-    insertKey :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-              => Key val -> val -> m ()
+    insertKey :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+              => Key val -> val -> 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 :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-            => Key val -> val -> m ()
+    repsert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+            => Key val -> val -> 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 :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-            => Key val -> val -> m ()
+    replace :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+            => Key val -> val -> ReaderT backend m ()
 
     -- | Delete a specific record by identifier. Does nothing if record does
     -- not exist.
-    delete :: (PersistMonadBackend m ~ PersistEntityBackend val, PersistEntity val)
-           => Key val -> m ()
+    delete :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
+           => Key val -> 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 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 key ups = do
+        update key ups
+        get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ Prelude.show key) return
+
+
 -- | 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 m, PersistEntity val, Show (Key val), PersistMonadBackend m ~ PersistEntityBackend val) => Key val -> m val
+getJust :: ( PersistStore backend
+           , PersistEntity val
+           , Show (Key val)
+           , backend ~ PersistEntityBackend val
+           , MonadIO m
+           ) => Key val -> ReaderT backend m val
 getJust key = get key >>= maybe
   (liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ Prelude.show key)
   return
@@ -99,50 +126,23 @@
 -- | curry this to make a convenience function that loads an associated model
 --   > foreign = belongsTo foeignId
 belongsTo ::
-  (PersistStore m
+  ( PersistStore backend
   , PersistEntity ent1
   , PersistEntity ent2
-  , PersistMonadBackend m ~ PersistEntityBackend ent2
-  ) => (ent1 -> Maybe (Key ent2)) -> ent1 -> m (Maybe ent2)
+  , backend ~ PersistEntityBackend ent2
+  , MonadIO m
+  ) => (ent1 -> Maybe (Key ent2)) -> ent1 -> ReaderT backend m (Maybe ent2)
 belongsTo foreignKeyField model = case foreignKeyField model of
     Nothing -> return Nothing
     Just f -> get f
 
 -- | same as belongsTo, but uses @getJust@ and therefore is similarly unsafe
 belongsToJust ::
-  (PersistStore m
+  ( PersistStore backend
   , PersistEntity ent1
   , PersistEntity ent2
-  , PersistMonadBackend m ~ PersistEntityBackend ent2)
-  => (ent1 -> Key ent2) -> ent1 -> m ent2
+  , backend ~ PersistEntityBackend ent2
+  , MonadIO m
+  )
+  => (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2
 belongsToJust getForeignKey model = getJust $ getForeignKey model
-
-#define DEF(T) { type PersistMonadBackend (T m) = PersistMonadBackend m; insert = lift . insert; insertKey k = lift . insertKey k; repsert k = lift . repsert k; replace k = lift . replace k; delete = lift . delete; get = lift . get }
-#define GO(T) instance (PersistStore m) => PersistStore (T m) where DEF(T)
-#define GOX(X, T) instance (X, PersistStore m) => PersistStore (T m) where DEF(T)
-
-GO(LoggingT)
-GO(IdentityT)
-GO(ListT)
-GO(MaybeT)
-GOX(Error e, ErrorT e)
-
-#if MIN_VERSION_transformers(0,4,0)
-GO(ExceptT e)
-#endif
-
-GO(ReaderT r)
-GO(ContT r)
-GO(StateT s)
-GO(ResourceT)
-GO(Pipe l i o u)
-GO(ConduitM i o)
-GOX(Monoid w, WriterT w)
-GOX(Monoid w, RWST r w s)
-GOX(Monoid w, Strict.RWST r w s)
-GO(Strict.StateT s)
-GOX(Monoid w, Strict.WriterT w)
-
-#undef DEF
-#undef GO
-#undef GOX
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
@@ -6,38 +6,21 @@
     , insertBy
     , replaceUnique
     , checkUnique
+    , onlyUnique
     ) where
 
+import Database.Persist.Types
 import qualified Prelude
-import Prelude hiding ((++), show)
+import Prelude hiding ((++))
 
-import Control.Monad (liftM)
-import Control.Monad.Trans.Error (Error (..))
-import Control.Monad.Trans.Class (lift)
-import Data.Monoid (Monoid)
+import Control.Exception (throwIO)
+import Control.Monad (liftM, when)
+import Control.Monad.IO.Class (liftIO)
 import Data.List ((\\))
 
-import Data.Conduit.Internal (Pipe)
-import Control.Monad.Logger (LoggingT)
-import Control.Monad.Trans.Identity ( IdentityT)
-import Control.Monad.Trans.List     ( ListT    )
-import Control.Monad.Trans.Maybe    ( MaybeT   )
-import Control.Monad.Trans.Error    ( ErrorT   )
-
-#if MIN_VERSION_transformers(0,4,0)
-import Control.Monad.Trans.Except   ( ExceptT  )
-#endif
-
 import Control.Monad.Trans.Reader   ( ReaderT  )
-import Control.Monad.Trans.Cont     ( ContT  )
-import Control.Monad.Trans.State    ( StateT   )
-import Control.Monad.Trans.Writer   ( WriterT  )
-import Control.Monad.Trans.RWS      ( RWST     )
-import Control.Monad.Trans.Resource ( ResourceT)
+import Control.Monad.IO.Class (MonadIO)
 
-import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
-import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
-import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 import Database.Persist.Class.PersistStore
 import Database.Persist.Class.PersistEntity
 
@@ -53,41 +36,74 @@
 --  * there is some fragility to trying to catch the correct exception and determing the column of failure.
 --
 --  * an exception will automatically abort the current SQL transaction
-class PersistStore m => PersistUnique m where
+class PersistStore backend => PersistUnique backend where
     -- | Get a record by unique key, if available. Returns also the identifier.
-    getBy :: (PersistEntityBackend val ~ PersistMonadBackend m, PersistEntity val) => Unique val -> m (Maybe (Entity val))
+    getBy :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val) => Unique val -> ReaderT backend m (Maybe (Entity val))
 
     -- | Delete a specific record by unique key. Does nothing if no record
     -- matches.
-    deleteBy :: (PersistEntityBackend val ~ PersistMonadBackend m, PersistEntity val) => Unique val -> m ()
+    deleteBy :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val) => Unique val -> ReaderT backend m ()
 
     -- | Like 'insert', but returns 'Nothing' when the record
     -- couldn't be inserted because of a uniqueness constraint.
-    insertUnique :: (PersistEntityBackend val ~ PersistMonadBackend m, PersistEntity val) => val -> m (Maybe (Key val))
+    insertUnique :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val) => val -> ReaderT backend m (Maybe (Key val))
     insertUnique datum = do
         conflict <- checkUnique datum
         case conflict of
           Nothing -> Just `liftM` insert datum
           Just _ -> return Nothing
 
+    -- | update based on a uniquness constraint or insert
+    --
+    -- insert the new record if it does not exist
+    -- 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] -- ^ 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) -- ^ the record in the database after the operation
+    upsert record updates = do
+        uniqueKey <- onlyUnique record 
+        mExists <- getBy uniqueKey
+        k <- case mExists of
+            Just (Entity k _) -> do
+              when (null updates) (replace k record)
+              return k
+            Nothing           -> insert record
+        Entity k `liftM` updateGet k updates
+
+
 -- | 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 :: (PersistEntity val, PersistUnique m, PersistEntityBackend val ~ PersistMonadBackend m)
-         => val -> m (Either (Entity val) (Key val))
-
+insertBy :: (MonadIO m, PersistEntity val, PersistUnique backend, PersistEntityBackend val ~ backend)
+         => val -> ReaderT backend m (Either (Entity val) (Key val))
 insertBy val = do
     res <- getByValue val
     case res of
       Nothing -> Right `liftM` insert val
       Just z -> return $ Left z
 
+-- | 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 record = case onlyUniqueEither record of
+    Right u -> return u
+    Left us -> liftIO $ throwIO $ OnlyUniqueException $ show $ length us
+
+onlyUniqueEither :: (PersistEntity val) => val -> Either [Unique val] (Unique val)
+onlyUniqueEither record = case persistUniqueKeys record of
+    (u:[]) -> Right u
+    us     -> Left us
+
 -- | A modification of 'getBy', which takes the 'PersistEntity' itself instead
 -- of a 'Unique' value. Returns a value matching /one/ of the unique keys. This
 -- function makes the most sense on entities with a single 'Unique'
 -- constructor.
-getByValue :: (PersistEntity value, PersistUnique m, PersistEntityBackend value ~ PersistMonadBackend m)
-           => value -> m (Maybe (Entity value))
+getByValue :: (MonadIO m, PersistEntity value, PersistUnique backend, PersistEntityBackend value ~ backend)
+           => value -> ReaderT backend m (Maybe (Entity value))
 getByValue = checkUniques . persistUniqueKeys
   where
     checkUniques [] = return Nothing
@@ -104,8 +120,8 @@
 -- If uniqueness is violated, return a 'Just' with the 'Unique' violation
 --
 -- Since 1.2.2.0
-replaceUnique :: (Eq record, Eq (Unique record), PersistEntityBackend record ~ PersistMonadBackend m, PersistEntity record, PersistStore m, PersistUnique m)
-              => Key record -> record -> m (Maybe (Unique record))
+replaceUnique :: (MonadIO m, Eq record, Eq (Unique record), PersistEntityBackend record ~ backend, PersistEntity record, PersistUnique backend)
+              => Key record -> record -> ReaderT backend m (Maybe (Unique record))
 replaceUnique key datumNew = getJust key >>= replaceOriginal
   where
     uniqueKeysNew = persistUniqueKeys datumNew
@@ -123,44 +139,15 @@
 --
 -- Returns 'Nothing' if the entity would be unique, and could thus safely be inserted.
 -- on a conflict returns the conflicting key
-checkUnique :: (PersistEntityBackend record ~ PersistMonadBackend m, PersistEntity record, PersistUnique m)
-            => record -> m (Maybe (Unique record))
+checkUnique :: (MonadIO m, PersistEntityBackend record ~ backend, PersistEntity record, PersistUnique backend)
+            => record -> ReaderT backend m (Maybe (Unique record))
 checkUnique = checkUniqueKeys . persistUniqueKeys
 
-checkUniqueKeys :: (PersistEntity record, PersistUnique m, PersistEntityBackend record ~ PersistMonadBackend m)
-                => [Unique record] -> m (Maybe (Unique record))
+checkUniqueKeys :: (MonadIO m, PersistEntity record, PersistUnique backend, PersistEntityBackend record ~ backend)
+                => [Unique record] -> ReaderT backend m (Maybe (Unique record))
 checkUniqueKeys [] = return Nothing
 checkUniqueKeys (x:xs) = do
     y <- getBy x
     case y of
         Nothing -> checkUniqueKeys xs
         Just _ -> return (Just x)
-
-#define DEF(T) { getBy = lift . getBy; deleteBy = lift . deleteBy; insertUnique = lift . insertUnique }
-#define GO(T) instance (PersistUnique m) => PersistUnique (T m) where DEF(T)
-#define GOX(X, T) instance (X, PersistUnique m) => PersistUnique (T m) where DEF(T)
-
-GO(LoggingT)
-GO(IdentityT)
-GO(ListT)
-GO(MaybeT)
-GOX(Error e, ErrorT e)
-
-#if MIN_VERSION_transformers(0,4,0)
-GO(ExceptT e)
-#endif
-
-GO(ReaderT r)
-GO(ContT r)
-GO(StateT s)
-GO(ResourceT)
-GO(Pipe l i o u)
-GOX(Monoid w, WriterT w)
-GOX(Monoid w, RWST r w s)
-GOX(Monoid w, Strict.RWST r w s)
-GO(Strict.StateT s)
-GOX(Monoid w, Strict.WriterT w)
-
-#undef DEF
-#undef GO
-#undef GOX
diff --git a/Database/Persist/Quasi.hs b/Database/Persist/Quasi.hs
--- a/Database/Persist/Quasi.hs
+++ b/Database/Persist/Quasi.hs
@@ -7,7 +7,6 @@
     , PersistSettings (..)
     , upperCaseSettings
     , lowerCaseSettings
-    , stripId
     , nullable
 #if TEST
     , Token (..)
@@ -100,7 +99,7 @@
     }
 
 -- | Parses a quasi-quoted syntax into a list of entity definitions.
-parse :: PersistSettings -> Text -> [EntityDef ()]
+parse :: PersistSettings -> Text -> [EntityDef]
 parse ps = parseLines ps
       . removeSpaces
       . filter (not . empty)
@@ -192,7 +191,7 @@
     fromToken Spaces{}  = Nothing
 
 -- | Divide lines into blocks and make entity definitions.
-parseLines :: PersistSettings -> [Line] -> [EntityDef ()]
+parseLines :: PersistSettings -> [Line] -> [EntityDef]
 parseLines ps lines =
     fixForeignKeysAll $ toEnts lines
   where
@@ -202,34 +201,48 @@
     toEnts (Line _ []:rest) = toEnts rest
     toEnts [] = []
 
-fixForeignKeysAll :: [EntityDef ()] -> [EntityDef ()]
+fixForeignKeysAll :: [EntityDef] -> [EntityDef]
 fixForeignKeysAll ents = map fixForeignKeys ents
-  where fixForeignKeys :: EntityDef () -> EntityDef ()
-        fixForeignKeys ent = ent { entityForeigns = map (fixForeignKey ent) (entityForeigns ent) }
-        -- check the count and the sqltypes match and update the foreignFields with the names of the primary columns
-        chktypes :: [FieldDef ()] -> HaskellName -> [FieldDef ()] -> HaskellName -> Bool
-        chktypes fflds fkey pflds pkey = case (filter ((== fkey) . fieldHaskell) fflds, filter ((== pkey) . fieldHaskell) pflds) of
-                                            ([ffld],[pfld]) -> fieldType ffld == fieldType pfld
-                                            xs -> error $ "unexpected result "++ show xs
-        fixForeignKey :: EntityDef () -> ForeignDef -> ForeignDef
-        fixForeignKey fent fdef = 
-           case find ((== foreignRefTableHaskell fdef) . entityHaskell) ents of
-             Just pent -> case entityPrimary pent of
-                           Just pdef -> if length (foreignFields fdef) == length (primaryFields pdef) 
-                                         then fdef { foreignFields = zipWith (\(a,b,_,_) (a',b') -> 
-                                                          if chktypes (entityFields fent) a (entityFields pent) a' 
-                                                            then (a,b,a',b') 
-                                                            else error ("type mismatch between foreign key and primary column" ++ show (a,a') ++ " primary ent="++show pent ++ " foreign ent="++show fent)) (foreignFields fdef) (primaryFields pdef) }
-                                         else error $ "found " ++ show (length (foreignFields fdef)) ++ " fkeys and " ++ show (length (primaryFields pdef)) ++ " pkeys: fdef=" ++ show fdef ++ " pdef=" ++ show pdef 
-                           Nothing -> error $ "no explicit primary key fdef="++show fdef++ " fent="++show fent
-             Nothing -> error $ "could not find table " ++ show (foreignRefTableHaskell fdef) ++ " fdef=" ++ show fdef ++ " allnames=" ++ show (map (unHaskellName . entityHaskell) ents) ++ "\n\nents=" ++ show ents
+  where
+    fixForeignKeys :: EntityDef -> EntityDef
+    fixForeignKeys ent = ent { entityForeigns = map (fixForeignKey ent) (entityForeigns ent) }
+    -- check the count and the sqltypes match and update the foreignFields with the names of the primary columns
+    chktypes :: [FieldDef] -> HaskellName -> [FieldDef] -> HaskellName -> Bool
+    chktypes fflds fkey pflds pkey = case (filter ((== fkey) . fieldHaskell) fflds, filter ((== pkey) . fieldHaskell) pflds) of
+                                        ([ffld],[pfld]) -> fieldType ffld == fieldType pfld
+                                        xs -> error $ "unexpected result "++ show xs
+    fixForeignKey :: EntityDef -> ForeignDef -> ForeignDef
+    fixForeignKey fent fdef =
+        case find ((== foreignRefTableHaskell fdef) . entityHaskell) ents of
+          Just pent -> case entityPrimary pent of
+             Just pdef ->
+                 if length (foreignFields fdef) == length (primaryFields pdef)
+                   then
+                     fdef { foreignFields = zipWith (toForeignFields pent)
+                              (foreignFields fdef)
+                              (primaryFields pdef) }
+                   else
+                     error $ "found " ++ show (length (foreignFields fdef)) ++ " fkeys and " ++ show (length (primaryFields pdef)) ++ " pkeys: fdef=" ++ show fdef ++ " pdef=" ++ show pdef
+             Nothing ->
+                 error $ "no explicit primary key fdef="++show fdef++ " fent="++show fent
+          Nothing ->
+             error $ "could not find table " ++ show (foreignRefTableHaskell fdef)
+               ++ " fdef=" ++ show fdef ++ " allnames="
+               ++ show (map (unHaskellName . entityHaskell) ents)
+               ++ "\n\nents=" ++ show ents
+      where
+        toForeignFields pent (a,b,_,_) fd =
+           let (a', b') = (fieldHaskell fd, fieldDB fd) in
+              if chktypes (entityFields fent) a (entityFields pent) a'
+                then (a,b,a',b')
+                else error ("type mismatch between foreign key and primary column" ++ show (a,a') ++ " primary ent="++show pent ++ " foreign ent="++show fent)
 
 -- | Construct an entity definition.
 mkEntityDef :: PersistSettings
             -> Text -- ^ name
             -> [Attr] -- ^ entity attributes
             -> [Line] -- ^ indented lines
-            -> EntityDef ()
+            -> EntityDef
 mkEntityDef ps name entattribs lines =
     EntityDef
         (HaskellName name')
@@ -262,7 +275,7 @@
                 
     derives = concat $ mapMaybe takeDerives attribs
 
-    cols :: [FieldDef ()]
+    cols :: [FieldDef]
     cols = mapMaybe (takeCols ps) attribs
 
 splitExtras :: [Line] -> ([[Text]], M.Map Text [[Text]])
@@ -276,7 +289,7 @@
     let (x, y) = splitExtras rest
      in (ts:x, y)
 
-takeCols :: PersistSettings -> [Text] -> Maybe (FieldDef ())
+takeCols :: PersistSettings -> [Text] -> Maybe FieldDef
 takeCols _ ("deriving":_) = Nothing
 takeCols ps (n':typ:rest)
     | not (T.null n) && isLower (T.head n) =
@@ -286,10 +299,10 @@
                 { fieldHaskell = HaskellName n
                 , fieldDB = DBName $ getDbName ps n rest
                 , fieldType = ft
-                , fieldSqlType = ()
+                , fieldSqlType = SqlOther $ "SqlType unset for " `mappend` n
                 , fieldAttrs = rest
                 , fieldStrict = fromMaybe (psStrictFields ps) mstrict
-                , fieldEmbedded = Nothing
+                , fieldReference = NoReference
                 }
   where
     (mstrict, n)
@@ -300,14 +313,11 @@
 
 getDbName :: PersistSettings -> Text -> [Text] -> Text
 getDbName ps n [] = psToDBName ps n
-getDbName ps n (a:as) =
-    case T.stripPrefix "sql=" a of
-      Nothing -> getDbName ps n as
-      Just s  -> s
+getDbName ps n (a:as) = fromMaybe (getDbName ps n as) $ T.stripPrefix "sql=" a
 
 takeConstraint :: PersistSettings
           -> Text
-          -> [FieldDef a]
+          -> [FieldDef]
           -> [Text]
           -> (Maybe PrimaryDef, Maybe UniqueDef, Maybe ForeignDef)
 takeConstraint ps tableName defs (n:rest) | not (T.null n) && isUpper (T.head n) = takeConstraint' 
@@ -318,25 +328,25 @@
             | otherwise      = (Nothing, Just $ takeUniq ps "" defs (n:rest), Nothing) -- retain compatibility with original unique constraint
 takeConstraint _ _ _ _ = (Nothing, Nothing, Nothing)
     
-takePrimary :: [FieldDef a]
+takePrimary :: [FieldDef]
             -> [Text]
             -> PrimaryDef
 takePrimary defs pkcols
         = PrimaryDef
-            (map (HaskellName &&& getDBName defs) pkcols)
+            (map (getDef defs) pkcols)
             attrs
   where
     (_, attrs) = break ("!" `T.isPrefixOf`) pkcols
-    getDBName [] t = error $ "Unknown column in primary key constraint: " ++ show t
-    getDBName (d:ds) t
+    getDef [] t = error $ "Unknown column in primary key constraint: " ++ show t
+    getDef (d:ds) t
         | nullable (fieldAttrs d) /= NotNullable = error $ "primary key column cannot be nullable: " ++ show t
-        | fieldHaskell d == HaskellName t = fieldDB d
-        | otherwise = getDBName ds t
+        | fieldHaskell d == HaskellName t = d
+        | otherwise = getDef ds t
 
 -- Unique UppercaseConstraintName list of lowercasefields    
 takeUniq :: PersistSettings
           -> Text
-          -> [FieldDef a]
+          -> [FieldDef]
           -> [Text]
           -> UniqueDef
 takeUniq ps tableName defs (n:rest)
@@ -356,7 +366,7 @@
 
 takeForeign :: PersistSettings
           -> Text
-          -> [FieldDef a]
+          -> [FieldDef]
           -> [Text]
           -> ForeignDef
 takeForeign ps tableName defs (refTableName:n:rest)
@@ -380,10 +390,6 @@
 takeDerives :: [Text] -> Maybe [Text]
 takeDerives ("deriving":rest) = Just rest
 takeDerives _ = Nothing
-
-stripId :: FieldType -> Maybe Text
-stripId (FTTypeCon Nothing t) = T.stripSuffix "Id" t
-stripId _ = Nothing
 
 nullable :: [Text] -> IsNullable
 nullable s
diff --git a/Database/Persist/Sql.hs b/Database/Persist/Sql.hs
--- a/Database/Persist/Sql.hs
+++ b/Database/Persist/Sql.hs
@@ -4,7 +4,9 @@
     , module Database.Persist.Sql.Run
     , module Database.Persist.Sql.Migration
     , module Database.Persist
+    , module Database.Persist.Sql.Orphan.PersistStore
     , rawQuery
+    , rawQueryRes
     , rawExecute
     , rawExecuteCount
     , rawSql
@@ -27,24 +29,25 @@
 import Database.Persist.Sql.Internal
 
 import Database.Persist.Sql.Orphan.PersistQuery 
-import Database.Persist.Sql.Orphan.PersistStore ()
+import Database.Persist.Sql.Orphan.PersistStore
 import Database.Persist.Sql.Orphan.PersistUnique ()
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader (ReaderT, ask)
 
 -- | Commit the current transaction and begin a new one.
 --
 -- Since 1.2.0
-transactionSave :: MonadSqlPersist m => m ()
+transactionSave :: MonadIO m => ReaderT Connection m ()
 transactionSave = do
-    conn <- askSqlConn
+    conn <- ask
     let getter = getStmtConn conn
     liftIO $ connCommit conn getter >> connBegin conn getter
 
 -- | Roll back the current transaction and begin a new one.
 --
 -- Since 1.2.0
-transactionUndo :: MonadSqlPersist m => m ()
+transactionUndo :: MonadIO m => ReaderT Connection m ()
 transactionUndo = do
-    conn <- askSqlConn
+    conn <- ask
     let getter = getStmtConn conn
     liftIO $ connRollback conn getter >> connBegin conn getter
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
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances #-}
@@ -7,8 +8,7 @@
 {-# LANGUAGE OverlappingInstances #-}
 #endif
 module Database.Persist.Sql.Class
-    ( MonadSqlPersist (..)
-    , RawSql (..)
+    ( RawSql (..)
     , PersistFieldSql (..)
     ) where
 
@@ -20,11 +20,8 @@
 import Data.Text (Text, intercalate, pack)
 import Data.Maybe (fromMaybe)
 import Data.Fixed
-
-import Data.Monoid (Monoid)
-import Control.Monad.Trans.Class (lift)
+import Data.Proxy (Proxy)
 
-import Control.Monad.Logger (LoggingT)
 import Control.Monad.Trans.Identity ( IdentityT)
 import Control.Monad.Trans.List     ( ListT    )
 import Control.Monad.Trans.Maybe    ( MaybeT   )
@@ -34,66 +31,24 @@
 import Control.Monad.Trans.Except   ( ExceptT  )
 #endif
 
-import Control.Monad.Trans.Cont     ( ContT  )
-import Control.Monad.Trans.State    ( StateT   )
-import Control.Monad.Trans.Writer   ( WriterT  )
-import Control.Monad.Trans.RWS      ( RWST     )
 import Control.Monad.Trans.Reader   ( ReaderT, ask  )
 import Control.Monad.Trans.Resource ( ResourceT )
 import Data.Conduit.Internal (Pipe, ConduitM)
 
-import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
-import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
-import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Trans.Class (MonadTrans)
-import Control.Monad.Logger (MonadLogger)
 
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.Time (ZonedTime, UTCTime, TimeOfDay, Day)
+import Data.Time (UTCTime, TimeOfDay, Day)
 import Data.Int
 import Data.Word
 import Data.ByteString (ByteString)
 import Text.Blaze.Html (Html)
 import Data.Bits (bitSize)
-
-class (MonadIO m, MonadLogger m) => MonadSqlPersist m where
-    askSqlConn :: m Connection
-    default askSqlConn :: (MonadSqlPersist m, MonadTrans t, MonadLogger (t m))
-                       => t m Connection
-    askSqlConn = lift askSqlConn
-
-instance (MonadIO m, MonadLogger m) => MonadSqlPersist (SqlPersistT m) where
-    askSqlConn = SqlPersistT ask
-
-#define GO(T) instance (MonadSqlPersist m) => MonadSqlPersist (T m)
-#define GOX(X, T) instance (X, MonadSqlPersist m) => MonadSqlPersist (T m)
-GO(LoggingT)
-GO(IdentityT)
-GO(ListT)
-GO(MaybeT)
-GOX(Error e, ErrorT e)
-
-#if MIN_VERSION_transformers(0,4,0)
-GO(ExceptT e)
-#endif
-
-GO(ReaderT r)
-GO(ContT r)
-GO(StateT s)
-GO(ResourceT)
-GO(Pipe l i o u)
-GO(ConduitM i o)
-GOX(Monoid w, WriterT w)
-GOX(Monoid w, RWST r w s)
-GOX(Monoid w, Strict.RWST r w s)
-GO(Strict.StateT s)
-GOX(Monoid w, Strict.WriterT w)
-#undef GO
-#undef GOX
+import qualified Data.Vector as V
 
 -- | Class for data types that may be retrived from a 'rawSql'
 -- query.
@@ -115,7 +70,7 @@
     rawSqlProcessRow [pv]  = Single <$> fromPersistValue pv
     rawSqlProcessRow _     = Left $ pack "RawSql (Single a): wrong number of columns."
 
-instance PersistEntity a => RawSql (Entity a) where
+instance (PersistEntity a, PersistEntityBackend a ~ SqlBackend) => RawSql (Entity a) where
     rawSqlCols escape = ((+1) . length . entityFields &&& process) . entityDef . Just . entityVal
         where
           process ed = (:[]) $
@@ -251,7 +206,7 @@
 extractMaybe = fromMaybe (error "Database.Persist.GenericSql.extractMaybe")
 
 class PersistField a => PersistFieldSql a where
-    sqlType :: Monad m => m a -> SqlType
+    sqlType :: Proxy a -> SqlType
 
 #ifndef NO_OVERLAP
 instance PersistFieldSql String where
@@ -298,10 +253,10 @@
     sqlType _ = SqlTime
 instance PersistFieldSql UTCTime where
     sqlType _ = SqlDayTime
-instance PersistFieldSql ZonedTime where
-    sqlType _ = SqlDayTimeZoned
 instance PersistFieldSql a => PersistFieldSql [a] where
     sqlType _ = SqlString
+instance PersistFieldSql a => PersistFieldSql (V.Vector a) where
+  sqlType _ = SqlString
 instance (Ord a, PersistFieldSql a) => PersistFieldSql (S.Set a) where
     sqlType _ = SqlString
 instance (PersistFieldSql a, PersistFieldSql b) => PersistFieldSql (a,b) where
@@ -323,9 +278,6 @@
 instance PersistFieldSql Rational where
     sqlType _ = SqlNumeric 32 20   --  need to make this field big enough to handle Rational to Mumber string conversion for ODBC
 
--- perhaps a SQL user can figure this sqlType out?
--- It is really intended for MongoDB though.
-instance PersistField entity => PersistFieldSql (Entity entity) where
-    sqlType _ = SqlOther "embedded entity, hard to type"
-instance PersistFieldSql (KeyBackend SqlBackend a) where
-    sqlType _ = SqlInt64
+-- An embedded Entity
+instance (PersistField record, PersistEntity record) => PersistFieldSql (Entity record) where
+    sqlType _ = SqlString
diff --git a/Database/Persist/Sql/Internal.hs b/Database/Persist/Sql/Internal.hs
--- a/Database/Persist/Sql/Internal.hs
+++ b/Database/Persist/Sql/Internal.hs
@@ -3,7 +3,6 @@
 -- | Intended for creating new backends.
 module Database.Persist.Sql.Internal
     ( mkColumns
-    , convertKey
     ) where
 
 import Database.Persist.Types
@@ -11,12 +10,11 @@
 import Data.Char (isSpace)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Monoid (Monoid, mappend, mconcat)
-import Data.Maybe (mapMaybe, listToMaybe)
+import Data.Monoid (mappend, mconcat)
 import Database.Persist.Sql.Types
 
 -- | Create the list of columns for the given entity.
-mkColumns :: [EntityDef a] -> EntityDef SqlType -> ([Column], [UniqueDef], [ForeignDef])
+mkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
 mkColumns allDefs t =
     (cols, entityUniques t, entityForeigns t)
   where
@@ -26,19 +24,16 @@
     tn :: DBName
     tn = entityDB t
 
-    go :: FieldDef SqlType -> Column
+    go :: FieldDef -> Column
     go fd =
         Column
             (fieldDB fd)
             (nullable (fieldAttrs fd) /= NotNullable || entitySum t)
-            (maybe
-                (fieldSqlType fd)
-                SqlOther
-                (listToMaybe $ mapMaybe (T.stripPrefix "sqltype=") $ fieldAttrs fd))
+            (fieldSqlType fd)
             (def $ fieldAttrs fd)
             Nothing
             (maxLen $ fieldAttrs fd)
-            (ref (fieldDB fd) (fieldType fd) (fieldAttrs fd))
+            (ref (fieldDB fd) (fieldReference fd) (fieldAttrs fd))
 
     def :: [Attr] -> Maybe Text
     def [] = Nothing
@@ -57,12 +52,12 @@
         | otherwise = maxLen as
 
     ref :: DBName
-        -> FieldType
+        -> ReferenceDef
         -> [Attr]
         -> Maybe (DBName, DBName) -- table name, constraint name
-    ref c ft []
-        | Just f <- stripId ft =
-            Just (resolveTableName allDefs $ HaskellName f, refName tn c)
+    ref c fe []
+        | ForeignRef f <- fe =
+            Just (resolveTableName allDefs f, refName tn c)
         | otherwise = Nothing
     ref _ _ ("noreference":_) = Nothing
     ref c _ (a:_)
@@ -74,13 +69,8 @@
 refName (DBName table) (DBName column) =
     DBName $ mconcat [table, "_", column, "_fkey"]
 
-resolveTableName :: [EntityDef a] -> HaskellName -> DBName
+resolveTableName :: [EntityDef] -> HaskellName -> DBName
 resolveTableName [] (HaskellName hn) = error $ "Table not found: " `mappend` T.unpack hn
 resolveTableName (e:es) hn
     | entityHaskell e == hn = entityDB e
     | otherwise = resolveTableName es hn
-
-convertKey :: Bool -> KeyBackend t t1 -> [PersistValue]
-convertKey True (Key (PersistList fks)) = fks
-convertKey False (Key ret@(PersistInt64 _)) = [ret]
-convertKey composite k = error $ "invalid key type " ++ show k ++ " composite=" ++ show composite
diff --git a/Database/Persist/Sql/Migration.hs b/Database/Persist/Sql/Migration.hs
--- a/Database/Persist/Sql/Migration.hs
+++ b/Database/Persist/Sql/Migration.hs
@@ -16,6 +16,7 @@
 import Control.Monad.Trans.Class (MonadTrans (..))
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Writer
+import Control.Monad.Trans.Reader (ReaderT (..), ask)
 import Control.Monad (liftM, unless)
 import Data.Text (Text, unpack, snoc, isPrefixOf, pack)
 import qualified Data.Text.IO
@@ -23,7 +24,6 @@
 import System.IO.Silently (hSilence)
 import Control.Monad.Trans.Control (liftBaseOp_)
 import Database.Persist.Sql.Types
-import Database.Persist.Sql.Class
 import Database.Persist.Sql.Raw
 import Database.Persist.Types
 
@@ -34,48 +34,50 @@
 safeSql :: CautiousMigration -> [Sql]
 safeSql = allSql . filter (not . fst)
 
-parseMigration :: Monad m => Migration m -> m (Either [Text] CautiousMigration)
+parseMigration :: MonadIO m => Migration -> ReaderT Connection m (Either [Text] CautiousMigration)
 parseMigration =
-    liftM go . runWriterT . execWriterT
+    liftIOReader . liftM go . runWriterT . execWriterT
   where
     go ([], sql) = Right sql
     go (errs, _) = Left errs
 
+    liftIOReader (ReaderT m) = ReaderT $ liftIO . m
+
 -- like parseMigration, but call error or return the CautiousMigration
-parseMigration' :: Monad m => Migration m -> m (CautiousMigration)
+parseMigration' :: MonadIO m => Migration -> ReaderT Connection m (CautiousMigration)
 parseMigration' m = do
   x <- parseMigration m
   case x of
       Left errs -> error $ unlines $ map unpack errs
       Right sql -> return sql
 
-printMigration :: MonadIO m => Migration m -> m ()
+printMigration :: MonadIO m => Migration -> ReaderT Connection m ()
 printMigration m = do
   mig <- parseMigration' m
   mapM_ (liftIO . Data.Text.IO.putStrLn . flip snoc ';') (allSql mig)
 
-getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration m -> m [Sql]
+getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration -> ReaderT Connection m [Sql]
 getMigration m = do
   mig <- parseMigration' m
   return $ allSql mig
 
-runMigration :: MonadSqlPersist m
-             => Migration m
-             -> m ()
+runMigration :: MonadIO m
+             => Migration
+             -> ReaderT Connection m ()
 runMigration m = runMigration' m False >> return ()
 
 -- | Same as 'runMigration', but returns a list of the SQL commands executed
 -- instead of printing them to stderr.
-runMigrationSilent :: (MonadBaseControl IO m, MonadSqlPersist m)
-                   => Migration m
-                   -> m [Text]
+runMigrationSilent :: (MonadBaseControl IO m, MonadIO m)
+                   => Migration
+                   -> ReaderT Connection m [Text]
 runMigrationSilent m = liftBaseOp_ (hSilence [stderr]) $ runMigration' m True
 
 runMigration'
-    :: MonadSqlPersist m
-    => Migration m
+    :: MonadIO m
+    => Migration
     -> Bool -- ^ is silent?
-    -> m [Text]
+    -> ReaderT Connection m [Text]
 runMigration' m silent = do
     mig <- parseMigration' m
     case unsafeSql mig of
@@ -86,14 +88,14 @@
             , unlines $ map (\s -> "    " ++ unpack s ++ ";") $ errs
             ]
 
-runMigrationUnsafe :: MonadSqlPersist m
-                   => Migration m
-                   -> m ()
+runMigrationUnsafe :: MonadIO m
+                   => Migration
+                   -> ReaderT Connection m ()
 runMigrationUnsafe m = do
     mig <- parseMigration' m
     mapM_ (executeMigrate False) $ sortMigrations $ allSql mig
 
-executeMigrate :: MonadSqlPersist m => Bool -> Text -> m Text
+executeMigrate :: MonadIO m => Bool -> Text -> ReaderT Connection m Text
 executeMigrate silent s = do
     unless silent $ liftIO $ hPutStrLn stderr $ "Migrating: " ++ unpack s
     rawExecute s []
@@ -109,11 +111,10 @@
     -- choose to have this special sorting applied.
     isCreate t = pack "CREATe " `isPrefixOf` t
 
-migrate :: MonadSqlPersist m
-        => [EntityDef SqlType]
-        -> EntityDef SqlType
-        -> Migration m
+migrate :: [EntityDef]
+        -> EntityDef
+        -> Migration
 migrate allDefs val = do
-    conn <- askSqlConn
+    conn <- lift $ lift ask
     res <- liftIO $ connMigrateSql conn allDefs (getStmtConn conn) val
     either tell (lift . tell) res
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,4 +1,5 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Database.Persist.Sql.Orphan.PersistQuery
@@ -9,18 +10,14 @@
 
 import Database.Persist
 import Database.Persist.Sql.Types
-import Database.Persist.Sql.Class
 import Database.Persist.Sql.Raw
-import Database.Persist.Sql.Orphan.PersistStore ()
-import Database.Persist.Sql.Internal (convertKey)
+import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
 import qualified Data.Text as T
 import Data.Text (Text)
 import Data.Monoid (Monoid (..), (<>))
 import Data.Int (Int64)
-import Control.Monad.Logger
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Resource (MonadResource)
+import Control.Monad.Trans.Reader (ReaderT, ask)
 import Control.Exception (throwIO)
 import qualified Data.Conduit.List as CL
 import Data.Conduit
@@ -29,36 +26,9 @@
 import Data.List (transpose, inits, find)
 
 -- orphaned instance for convenience of modularity
-instance (MonadResource m, MonadLogger m) => PersistQuery (SqlPersistT m) where
-    update _ [] = return ()
-    update k upds = do
-        conn <- askSqlConn
-        let go'' n Assign = n <> "=?"
-            go'' n Add = T.concat [n, "=", n, "+?"]
-            go'' n Subtract = T.concat [n, "=", n, "-?"]
-            go'' n Multiply = T.concat [n, "=", n, "*?"]
-            go'' n Divide = T.concat [n, "=", n, "/?"]
-        let go' (x, pu) = go'' (connEscapeName conn x) pu
-        let composite = isJust $ entityPrimary t
-        let wher = case entityPrimary t of
-                Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (snd fld) <> "=? ") $ primaryFields pdef
-                Nothing   -> connEscapeName conn (entityID t) <> "=?"
-        let sql = T.concat
-                [ "UPDATE "
-                , connEscapeName conn $ entityDB t
-                , " SET "
-                , T.intercalate "," $ map (go' . go) upds
-                , " WHERE "
-                , wher
-                ]
-        rawExecute sql $
-            map updatePersistValue upds `mappend` (convertKey composite k)
-      where
-        t = entityDef $ dummyFromKey k
-        go x = (fieldDB $ updateFieldDef x, updateUpdate x)
-
+instance PersistQuery Connection where
     count filts = do
-        conn <- askSqlConn
+        conn <- ask
         let wher = if null filts
                     then ""
                     else filterClause False conn filts
@@ -67,7 +37,7 @@
                 , connEscapeName conn $ entityDB t
                 , wher
                 ]
-        rawQuery sql (getFiltsValues conn filts) $$ do
+        withRawQuery sql (getFiltsValues conn filts) $ do
             mm <- CL.head
             case mm of
               Just [PersistInt64 i] -> return $ fromIntegral i
@@ -80,9 +50,10 @@
       where
         t = entityDef $ dummyFromFilts filts
 
-    selectSource filts opts = do
-        conn <- lift askSqlConn
-        rawQuery (sql conn) (getFiltsValues conn filts) $= CL.mapM parse
+    selectSourceRes filts opts = do
+        conn <- ask
+        srcRes <- rawQueryRes (sql conn) (getFiltsValues conn filts)
+        return $ fmap ($= CL.mapM parse) srcRes
       where
         composite = isJust $ entityPrimary t
         (limit, offset, orders) = limitOffsetOrder opts
@@ -90,7 +61,7 @@
         parse vals =
           case entityPrimary t of
             Just pdef -> 
-                  let pks = map fst $ primaryFields pdef
+                  let pks = map fieldHaskell $ primaryFields pdef
                       keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) vals
                   in case fromPersistValuesComposite' keyvals vals of
                       Left s -> liftIO $ throwIO $ PersistMarshalError s
@@ -101,21 +72,26 @@
                     Right row -> return row
 
         t = entityDef $ dummyFromFilts filts
-        fromPersistValues' (PersistInt64 x:xs) = 
-            case fromPersistValues xs of
-                Left e -> Left e
-                Right xs' -> Right (Entity (Key $ PersistInt64 x) xs')
-        fromPersistValues' (PersistDouble x:xs) = -- oracle returns Double 
+
+        fromPersistValues' (kpv:xs) = -- oracle returns Double 
             case fromPersistValues xs of
                 Left e -> Left e
-                Right xs' -> Right (Entity (Key $ PersistInt64 (truncate x)) xs') -- convert back to int64
+                Right xs' ->
+                    case keyFromValues [kpv] of
+                        Left _ -> error $ "fromPersistValues': keyFromValues failed on " ++ show kpv
+                        Right k -> Right (Entity k xs')
+
+
         fromPersistValues' xs = Left $ T.pack ("error in fromPersistValues' xs=" ++ show xs)
 
         fromPersistValuesComposite' keyvals xs =
             case fromPersistValues xs of
                 Left e -> Left e
-                Right xs' -> Right (Entity (Key $ PersistList keyvals) xs')
+                Right xs' -> case keyFromValues keyvals of
+                    Left _ -> error "fromPersistValuesComposite': keyFromValues failed"
+                    Right key -> Right (Entity key xs')
 
+
         wher conn = if null filts
                     then ""
                     else filterClause False conn filts
@@ -135,13 +111,14 @@
             , ord conn
             ]
 
-    selectKeys filts opts = do
-        conn <- lift askSqlConn
-        rawQuery (sql conn) (getFiltsValues conn filts) $= CL.mapM parse
+    selectKeysRes filts opts = do
+        conn <- ask
+        srcRes <- rawQueryRes (sql conn) (getFiltsValues conn filts)
+        return $ fmap ($= CL.mapM parse) srcRes
       where
         t = entityDef $ dummyFromFilts filts
         cols conn = case entityPrimary t of 
-                     Just pdef -> T.intercalate "," $ map (connEscapeName conn . snd) $ primaryFields pdef
+                     Just pdef -> T.intercalate "," $ map (connEscapeName conn . fieldDB) $ primaryFields pdef
                      Nothing   -> connEscapeName conn $ entityID t
                       
         wher conn = if null filts
@@ -163,17 +140,23 @@
                 [] -> ""
                 ords -> " ORDER BY " <> T.intercalate "," ords
 
-        parse xs = case entityPrimary t of
+        parse xs = do
+            keyvals <- case entityPrimary t of
                       Nothing -> 
                         case xs of
-                           [PersistInt64 x] -> return $ Key $ PersistInt64 x
-                           [PersistDouble x] -> return $ Key $ PersistInt64 (truncate x) -- oracle returns Double 
+                           [PersistInt64 x] -> return [PersistInt64 x]
+                           [PersistDouble x] -> return [PersistInt64 (truncate x)] -- oracle returns Double 
                            _ -> liftIO $ throwIO $ PersistMarshalError $ "Unexpected in selectKeys False: " <> T.pack (show xs)
                       Just pdef -> 
-                           let pks = map fst $ primaryFields pdef
+                           let pks = map fieldHaskell $ primaryFields pdef
                                keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) xs
-                           in return $ Key $ PersistList keyvals
+                           in return keyvals
+            case keyFromValues keyvals of
+                Right k -> return k
+                Left _ -> error "selectKeysImpl: keyFromValues failed"
 
+
+
     deleteWhere filts = do
         _ <- deleteWhereCount filts
         return ()
@@ -185,11 +168,11 @@
 -- | Same as 'deleteWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-deleteWhereCount :: (PersistEntity val, MonadSqlPersist m)
+deleteWhereCount :: (PersistEntity val, MonadIO m)
                  => [Filter val]
-                 -> m Int64
+                 -> ReaderT Connection m Int64
 deleteWhereCount filts = do
-    conn <- askSqlConn
+    conn <- ask
     let t = entityDef $ dummyFromFilts filts
     let wher = if null filts
                 then ""
@@ -204,13 +187,13 @@
 -- | Same as 'updateWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-updateWhereCount :: (PersistEntity val, MonadSqlPersist m)
+updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ PersistEntityBackend val)
                  => [Filter val]
                  -> [Update val]
-                 -> m Int64
+                 -> ReaderT Connection m Int64
 updateWhereCount _ [] = return 0
 updateWhereCount filts upds = do
-    conn <- askSqlConn
+    conn <- ask
     let wher = if null filts
                 then ""
                 else filterClause False conn filts
@@ -234,8 +217,9 @@
     go' conn (x, pu) = go'' (connEscapeName conn x) pu
     go x = (fieldDB $ updateFieldDef x, updateUpdate x)
 
-updateFieldDef :: PersistEntity v => Update v -> FieldDef SqlType
+updateFieldDef :: PersistEntity v => Update v -> FieldDef
 updateFieldDef (Update f _ _) = persistFieldDef f
+updateFieldDef _ = error "BackendUpdate not implemented"
 
 dummyFromFilts :: [Filter v] -> Maybe v
 dummyFromFilts _ = Nothing
@@ -281,23 +265,23 @@
                     else
                       case (allVals, pfilter, isCompFilter pfilter) of
                         ([PersistList xs], Eq, _) -> 
-                           let sqlcl=T.intercalate " and " (map (\a -> connEscapeName conn (snd a) <> showSqlFilter pfilter <> "? ")  (primaryFields pdef))
+                           let sqlcl=T.intercalate " and " (map (\a -> connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "? ")  (primaryFields pdef))
                            in (wrapSql sqlcl,xs)
                         ([PersistList xs], Ne, _) -> 
-                           let sqlcl=T.intercalate " or " (map (\a -> connEscapeName conn (snd a) <> showSqlFilter pfilter <> "? ")  (primaryFields pdef))
+                           let sqlcl=T.intercalate " or " (map (\a -> connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "? ")  (primaryFields pdef))
                            in (wrapSql sqlcl,xs)
                         (_, In, _) -> 
                            let xxs = transpose (map fromPersistList allVals)
-                               sqls=map (\(a,xs) -> connEscapeName conn (snd a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate (length xs) " ?") <> ") ") (zip (primaryFields pdef) xxs)
+                               sqls=map (\(a,xs) -> connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate (length xs) " ?") <> ") ") (zip (primaryFields pdef) xxs)
                            in (wrapSql (T.intercalate " and " (map wrapSql sqls)), concat xxs)
                         (_, NotIn, _) -> 
                            let xxs = transpose (map fromPersistList allVals)
-                               sqls=map (\(a,xs) -> connEscapeName conn (snd a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate (length xs) " ?") <> ") ") (zip (primaryFields pdef) xxs)
+                               sqls=map (\(a,xs) -> connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate (length xs) " ?") <> ") ") (zip (primaryFields pdef) xxs)
                            in (wrapSql (T.intercalate " or " (map wrapSql sqls)), concat xxs)
                         ([PersistList xs], _, True) -> 
                            let zs = tail (inits (primaryFields pdef))
                                sql1 = map (\b -> wrapSql (T.intercalate " and " (map (\(i,a) -> sql2 (i==length b) a) (zip [1..] b)))) zs
-                               sql2 islast a = connEscapeName conn (snd a) <> (if islast then showSqlFilter pfilter else showSqlFilter Eq) <> "? "
+                               sql2 islast a = connEscapeName conn (fieldDB a) <> (if islast then showSqlFilter pfilter else showSqlFilter Eq) <> "? "
                                sqlcl = T.intercalate " or " sql1
                            in (wrapSql sqlcl, concat (tail (inits xs)))
                         (_, BackendSpecificFilter _, _) -> error "unhandled type BackendSpecificFilter for composite/non id primary keys"
@@ -399,6 +383,7 @@
 
 updatePersistValue :: Update v -> PersistValue
 updatePersistValue (Update _ v _) = toPersistValue v
+updatePersistValue _ = error "BackendUpdate not implemented"
 
 filterClause :: PersistEntity val
              => Bool -- ^ include table name?
@@ -416,7 +401,7 @@
     case o of
         Asc  x -> name $ persistFieldDef x
         Desc x -> name (persistFieldDef x) <> " DESC"
-        _ -> error $ "orderClause: expected Asc or Desc, not limit or offset"
+        _ -> error "orderClause: expected Asc or Desc, not limit or offset"
   where
     dummyFromOrder :: SelectOpt a -> Maybe a
     dummyFromOrder _ = Nothing
@@ -428,9 +413,6 @@
             then ((tn <> ".") <>)
             else id)
         $ connEscapeName conn $ fieldDB x
-
-dummyFromKey :: KeyBackend SqlBackend v -> Maybe v
-dummyFromKey _ = Nothing
 
 -- | Generates sql for limit and offset for postgres, sqlite and mysql.
 decorateSQLWithLimitOffset::Text -> (Int,Int) -> Bool -> Text -> Text 
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,58 +1,113 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Database.Persist.Sql.Orphan.PersistStore () where
+module Database.Persist.Sql.Orphan.PersistStore (withRawQuery, BackendKey(..)) where
 
 import Database.Persist
 import Database.Persist.Sql.Types
-import Database.Persist.Sql.Class
 import Database.Persist.Sql.Raw
-import Database.Persist.Sql.Internal (convertKey)
 import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
-import Control.Monad.Logger
 import qualified Data.Text as T
-import Data.Text (Text, unpack)
+import Data.Text (Text, unpack, pack)
 import Data.Monoid (mappend, (<>))
 import Control.Monad.IO.Class
 import Data.ByteString.Char8 (readInteger)
 import Data.Maybe (isJust)
 import Data.List (find)
-import Control.Monad.Trans.Resource (MonadResource)
+import Control.Monad.Trans.Reader (ReaderT, ask)
+import Data.Acquire (with)
+import Data.Int (Int64)
+import Web.PathPieces (PathPiece)
+import Database.Persist.Sql.Class (PersistFieldSql)
+import qualified Data.Aeson as A
 
-instance (MonadResource m, MonadLogger m) => PersistStore (SqlPersistT m) where
-    type PersistMonadBackend (SqlPersistT m) = SqlBackend
+withRawQuery :: MonadIO m
+             => Text
+             -> [PersistValue]
+             -> C.Sink [PersistValue] IO a
+             -> ReaderT Connection m a
+withRawQuery sql vals sink = do
+    srcRes <- rawQueryRes sql vals
+    liftIO $ with srcRes (C.$$ sink)
+
+instance PersistStore Connection where
+    newtype BackendKey SqlBackend = SqlBackendKey { unSqlBackendKey :: Int64 }
+        deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, Real, Enum, Bounded, A.ToJSON, A.FromJSON)
+
+    backendKeyToValues (SqlBackendKey i)   = [PersistInt64 i]
+    backendKeyFromValues [PersistInt64 i]  = Right $ SqlBackendKey i
+    backendKeyFromValues [PersistDouble i] = Right $ SqlBackendKey $ truncate i
+    backendKeyFromValues s = Left $ pack $ show s
+
+    update _ [] = return ()
+    update k upds = do
+        conn <- ask
+        let go'' n Assign = n <> "=?"
+            go'' n Add = T.concat [n, "=", n, "+?"]
+            go'' n Subtract = T.concat [n, "=", n, "-?"]
+            go'' n Multiply = T.concat [n, "=", n, "*?"]
+            go'' n Divide = T.concat [n, "=", n, "/?"]
+        let go' (x, pu) = go'' (connEscapeName conn x) pu
+        let wher = case entityPrimary t of
+                Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (fieldDB fld) <> "=? ") $ primaryFields pdef
+                Nothing   -> connEscapeName conn (entityID t) <> "=?"
+        let sql = T.concat
+                [ "UPDATE "
+                , connEscapeName conn $ entityDB t
+                , " SET "
+                , T.intercalate "," $ map (go' . go) upds
+                , " WHERE "
+                , wher
+                ]
+        rawExecute sql $
+            map updatePersistValue upds `mappend` keyToValues k
+      where
+        t = entityDef $ dummyFromKey k
+        go x = (fieldDB $ updateFieldDef x, updateUpdate x)
+
     insert val = do
-        conn <- askSqlConn
+        conn <- ask
         let esql = connInsertSql conn t vals
         key <-
             case esql of
-                ISRSingle sql -> rawQuery sql vals C.$$ do
+                ISRSingle sql -> withRawQuery sql vals $ do
                     x <- CL.head
                     case x of
-                        Just [PersistInt64 i] -> return $ Key $ PersistInt64 i
+                        Just [PersistInt64 i] -> case keyFromValues [PersistInt64 i] of
+                            Left err -> error $ "SQL insert: keyFromValues: PersistInt64 " `mappend` show i `mappend` " " `mappend` unpack err
+                            Right k -> return k
                         Nothing -> error $ "SQL insert did not return a result giving the generated ID"
-                        Just vals' -> error $ "Invalid result from a SQL insert, got: " ++ show vals'
+                        Just vals' -> case keyFromValues vals' of
+                            Left _ -> error $ "Invalid result from a SQL insert, got: " ++ show vals'
+                            Right k -> return k
+
                 ISRInsertGet sql1 sql2 -> do
                     rawExecute sql1 vals
-                    rawQuery sql2 [] C.$$ do
+                    withRawQuery sql2 [] $ do
                         mm <- CL.head
-                        case mm of
-                          Just [PersistInt64 i] -> return $ Key $ PersistInt64 i
-                          Just [PersistDouble i] ->return $ Key $ PersistInt64 $ truncate i -- oracle need this!
-                          Just [PersistByteString i] -> case readInteger i of -- mssql
-                                                          Just (ret,"") -> return $ Key $ PersistInt64 $ fromIntegral ret
-                                                          xs -> error $ "invalid number i["++show i++"] xs[" ++ show xs ++ "]"
-                          Just xs -> error $ "invalid sql2 return xs["++show xs++"] sql2["++show sql2++"] sql1["++show sql1++"]"
-                          Nothing -> error $ "invalid sql2 returned nothing sql2["++show sql2++"] sql1["++show sql1++"]"
+                        i <- case mm of
+                            Just [PersistInt64 i] -> return $ i
+                            Just [PersistDouble i] ->return $ truncate i -- oracle need this!
+                            Just [PersistByteString i] -> case readInteger i of -- mssql
+                                                            Just (ret,"") -> return $ fromIntegral ret
+                                                            xs -> error $ "invalid number i["++show i++"] xs[" ++ show xs ++ "]"
+                            Just xs -> error $ "invalid sql2 return xs["++show xs++"] sql2["++show sql2++"] sql1["++show sql1++"]"
+                            Nothing -> error $ "invalid sql2 returned nothing sql2["++show sql2++"] sql1["++show sql1++"]"
+                        case keyFromValues [PersistInt64 i] of
+                            Right k -> return k
+                            Left err -> error $ "ISRInsertGet: keyFromValues failed: " `mappend` unpack err
                 ISRManyKeys sql fs -> do
                     rawExecute sql vals 
                     case entityPrimary t of
                        Nothing -> error $ "ISRManyKeys is used when Primary is defined " ++ show sql
                        Just pdef -> 
-                            let pks = map fst $ primaryFields pdef
+                            let pks = map fieldHaskell $ primaryFields pdef
                                 keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) fs
-                            in return $ Key $ PersistList keyvals
+                            in  case keyFromValues keyvals of
+                                    Right k -> return k
+                                    Left e  -> error $ "ISRManyKeys: unexpected keyvals result: " `mappend` unpack e
 
         return key
       where
@@ -60,7 +115,7 @@
         vals = map toPersistValue $ toPersistFields val
 
     replace k val = do
-        conn <- askSqlConn
+        conn <- ask
         let t = entityDef $ Just val
         let sql = T.concat
                 [ "UPDATE "
@@ -71,7 +126,7 @@
                 , connEscapeName conn $ entityID t
                 , "=?"
                 ]
-            vals = map toPersistValue (toPersistFields val) `mappend` [unKey k]
+            vals = map toPersistValue (toPersistFields val) `mappend` keyToValues k
         rawExecute sql vals
       where
         go conn x = connEscapeName conn x `T.append` "=?"
@@ -85,15 +140,14 @@
           Just _ -> replace key value
 
     get k = do
-        conn <- askSqlConn
+        conn <- ask
         let t = entityDef $ dummyFromKey k
-        let composite = isJust $ entityPrimary t
         let cols = T.intercalate ","
                  $ map (connEscapeName conn . fieldDB) $ entityFields t
             noColumns :: Bool
             noColumns = null $ entityFields t
         let wher = case entityPrimary t of
-                     Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (snd fld) <> "=? ") $ primaryFields pdef
+                     Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (fieldDB fld) <> "=? ") $ primaryFields pdef
                      Nothing   -> connEscapeName conn (entityID t) <> "=?"
         let sql = T.concat
                 [ "SELECT "
@@ -103,24 +157,23 @@
                 , " WHERE "
                 , wher
                 ]
-        rawQuery sql (convertKey composite k) C.$$ do
+        withRawQuery sql (keyToValues k) $ do
             res <- CL.head
             case res of
                 Nothing -> return Nothing
                 Just vals ->
                     case fromPersistValues $ if noColumns then [] else vals of
-                        Left e -> error $ "get " ++ show (unKey k) ++ ": " ++ unpack e
+                        Left e -> error $ "get " ++ show k ++ ": " ++ unpack e
                         Right v -> return $ Just v
 
     delete k = do
-        conn <- askSqlConn
-        rawExecute (sql conn) (convertKey composite k)
+        conn <- ask
+        rawExecute (sql conn) (keyToValues k)
       where
         t = entityDef $ dummyFromKey k
-        composite = isJust $ entityPrimary t 
         wher conn = 
               case entityPrimary t of
-                Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (snd fld) <> "=? ") $ primaryFields pdef
+                Just pdef -> T.intercalate " AND " $ map (\fld -> connEscapeName conn (fieldDB fld) <> "=? ") $ primaryFields pdef
                 Nothing   -> connEscapeName conn (entityID t) <> "=?"
         sql conn = T.concat
             [ "DELETE FROM "
@@ -129,16 +182,16 @@
             , wher conn
             ]
 
-dummyFromKey :: KeyBackend SqlBackend v -> Maybe v
+dummyFromKey :: Key v -> Maybe v
 dummyFromKey _ = Nothing
 
-insrepHelper :: (MonadIO m, PersistEntity val, MonadLogger m, MonadSqlPersist m)
+insrepHelper :: (MonadIO m, PersistEntity val)
              => Text
              -> Key val
              -> val
-             -> m ()
-insrepHelper command (Key k) val = do
-    conn <- askSqlConn
+             -> ReaderT Connection m ()
+insrepHelper command k val = do
+    conn <- ask
     rawExecute (sql conn) vals
   where
     t = entityDef $ Just val
@@ -154,4 +207,11 @@
         , T.intercalate "," ("?" : map (const "?") (entityFields t))
         , ")"
         ]
-    vals = k : map toPersistValue (toPersistFields val)
+    vals = keyToValues k ++ map toPersistValue (toPersistFields val)
+
+updateFieldDef :: PersistEntity v => Update v -> FieldDef
+updateFieldDef (Update f _ _) = persistFieldDef f
+updateFieldDef (BackendUpdate {}) = error "updateFieldDef did not expect BackendUpdate"
+
+updatePersistValue :: Update v -> PersistValue
+updatePersistValue (Update _ v _) = toPersistValue v
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
@@ -4,26 +4,25 @@
 
 import Database.Persist
 import Database.Persist.Sql.Types
-import Database.Persist.Sql.Class
 import Database.Persist.Sql.Raw
-import Database.Persist.Sql.Orphan.PersistStore ()
+import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
 import qualified Data.Text as T
-import Data.Monoid ((<>))
+import Data.Monoid (mappend)
 import Control.Monad.Logger
 import qualified Data.Conduit.List as CL
 import Data.Conduit
-import Control.Monad.Trans.Resource (MonadResource)
+import Control.Monad.Trans.Reader (ask)
 
-instance (MonadResource m, MonadLogger m) => PersistUnique (SqlPersistT m) where
+instance PersistUnique Connection where
     deleteBy uniq = do
-        conn <- askSqlConn
+        conn <- ask
         let sql' = sql conn
             vals = persistUniqueToValues uniq
         rawExecute sql' vals
       where
         t = entityDef $ dummyFromUnique uniq
         go = map snd . persistUniqueToFieldNames
-        go' conn x = connEscapeName conn x <> "=?"
+        go' conn x = connEscapeName conn x `mappend` "=?"
         sql conn = T.concat
             [ "DELETE FROM "
             , connEscapeName conn $ entityDB t
@@ -32,7 +31,7 @@
             ]
 
     getBy uniq = do
-        conn <- askSqlConn
+        conn <- ask
         let flds = map (connEscapeName conn . fieldDB) (entityFields t)
         let cols = case entityPrimary t of
                      Just _ -> T.intercalate "," flds
@@ -46,23 +45,22 @@
                 , sqlClause conn
                 ]
             vals' = persistUniqueToValues uniq
-        rawQuery sql vals' $$ do
+        withRawQuery sql vals' $ do
             row <- CL.head
             case row of
                 Nothing -> return Nothing
-                Just (PersistInt64 k:vals) ->
-                    case fromPersistValues vals of
-                        Left s -> error $ T.unpack s
-                        Right x -> return $ Just (Entity (Key $ PersistInt64 k) x)
-                Just (PersistDouble k:vals) ->   -- oracle
+                Just [] -> error "getBy: empty row"
+                Just (kpv:vals) ->
                     case fromPersistValues vals of
                         Left s -> error $ T.unpack s
-                        Right x -> return $ Just (Entity (Key $ PersistInt64 $ truncate k) x)
-                Just xs -> error $ "Database.Persist.GenericSql: Bad list in getBy xs="++show xs
+                        Right x ->
+                            case keyFromValues [kpv] of
+                                Right k -> return $ Just (Entity k x)
+                                Left _ -> error $ "getBy: keyFromValues failed: " `mappend` show kpv
       where
         sqlClause conn =
             T.intercalate " AND " $ map (go conn) $ toFieldNames' uniq
-        go conn x = connEscapeName conn x <> "=?"
+        go conn x = connEscapeName conn x `mappend` "=?"
         t = entityDef $ dummyFromUnique uniq
         toFieldNames' = map snd . persistUniqueToFieldNames
 
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,49 +1,67 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Database.Persist.Sql.Raw where
 
 import Database.Persist
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Class
 import qualified Data.Map as Map
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Reader (ReaderT, ask, MonadReader)
+import Control.Monad.Trans.Resource (release)
+import Data.Acquire (allocateAcquire, Acquire, mkAcquire, with)
 import Data.IORef (writeIORef, readIORef, newIORef)
 import Control.Exception (throwIO)
 import Control.Monad (when, liftM)
 import Data.Text (Text, pack)
-import Control.Monad.Logger (logDebugS)
+import Control.Monad.Logger (logDebugS, runLoggingT)
 import Data.Int (Int64)
-import Control.Monad.Trans.Class (lift)
 import qualified Data.Text as T
 import Data.Conduit
 import Control.Monad.Trans.Resource (MonadResource)
 
-rawQuery :: (MonadSqlPersist m, MonadResource m)
+rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env Connection)
          => Text
          -> [PersistValue]
          -> Source m [PersistValue]
 rawQuery sql vals = do
-    lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
-    conn <- lift askSqlConn
-    bracketP
-        (getStmtConn conn sql)
-        stmtReset
-        (flip stmtQuery vals)
+    srcRes <- liftPersist $ rawQueryRes sql vals
+    (releaseKey, src) <- allocateAcquire srcRes
+    src
+    release releaseKey
 
-rawExecute :: MonadSqlPersist m => Text -> [PersistValue] -> m ()
+rawQueryRes
+    :: (MonadIO m1, MonadIO m2)
+    => Text
+    -> [PersistValue]
+    -> ReaderT Connection m1 (Acquire (Source m2 [PersistValue]))
+rawQueryRes sql vals = do
+    conn <- ask
+    let make = do
+            runLoggingT ($logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals)
+                (connLogFunc conn)
+            getStmtConn conn sql
+    return $ do
+        stmt <- mkAcquire make stmtReset
+        stmtQuery stmt vals
+
+rawExecute :: MonadIO m => Text -> [PersistValue] -> ReaderT Connection m ()
 rawExecute x y = liftM (const ()) $ rawExecuteCount x y
 
-rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
+rawExecuteCount :: MonadIO m => Text -> [PersistValue] -> ReaderT Connection m Int64
 rawExecuteCount sql vals = do
-    $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
+    conn <- ask
+    runLoggingT ($logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals)
+        (connLogFunc conn)
     stmt <- getStmt sql
     res <- liftIO $ stmtExecute stmt vals
     liftIO $ stmtReset stmt
     return res
 
-getStmt :: MonadSqlPersist m => Text -> m Statement
+getStmt :: MonadIO m => Text -> ReaderT Connection m Statement
 getStmt sql = do
-    conn <- askSqlConn
+    conn <- ask
     liftIO $ getStmtConn conn sql
 
 getStmtConn :: Connection -> Text -> IO Statement
@@ -101,10 +119,10 @@
 -- However, most common problems are mitigated by using the
 -- entity selection placeholder @??@, and you shouldn't see any
 -- error at all if you're not using 'Single'.
-rawSql :: (RawSql a, MonadSqlPersist m, MonadResource m)
+rawSql :: (RawSql a, MonadIO m)
        => Text             -- ^ SQL statement, possibly with placeholders.
        -> [PersistValue]   -- ^ Values to fill the placeholders.
-       -> m [a]
+       -> ReaderT Connection m [a]
 rawSql stmt = run
     where
       getType :: (x -> m [a]) -> a
@@ -113,8 +131,9 @@
       x = getType run
       process = rawSqlProcessRow
 
-      withStmt' colSubsts params = do
-            rawQuery sql params
+      withStmt' colSubsts params sink = do
+            srcRes <- rawQueryRes sql params
+            liftIO $ with srcRes ($$ sink)
           where
             sql = T.concat $ makeSubsts colSubsts $ T.splitOn placeholder stmt
             placeholder = "??"
@@ -131,9 +150,9 @@
                         ]
 
       run params = do
-        conn <- askSqlConn
+        conn <- ask
         let (colCount, colSubsts) = rawSqlCols (connEscapeName conn) x
-        withStmt' colSubsts params $$ firstRow colCount
+        withStmt' colSubsts params $ firstRow colCount
 
       firstRow colCount = do
         mrow <- await
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
@@ -3,8 +3,9 @@
 
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Raw
+import Control.Monad.Trans.Control
 import Data.Pool as P
-import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Reader hiding (local)
 import Control.Monad.Trans.Resource
 import Control.Monad.Logger
 import Control.Monad.Base
@@ -17,7 +18,9 @@
 import Data.IORef (readIORef)
 import qualified Data.Map as Map
 import Control.Exception.Lifted (throwIO)
+import Control.Exception (mask)
 import Control.Monad (liftM)
+import System.Timeout (timeout)
 
 -- | Get a connection from the pool, run the given action, and then return the
 -- connection to the pool.
@@ -26,26 +29,30 @@
     mres <- withResourceTimeout 2000000 pconn $ runSqlConn r
     maybe (throwIO Couldn'tGetSQLConnection) return mres
 
-withResourceTimeout
-  :: (MonadBaseControl IO m)
+-- | Like 'withResource', but times out the operation if resource
+-- allocation does not complete within the given timeout period.
+--
+-- Since 2.0.0
+withResourceTimeout ::
+    (MonadBaseControl IO m)
   => Int -- ^ Timeout period in microseconds
-  -> P.Pool a
+  -> Pool a
   -> (a -> m b)
   -> m (Maybe b)
-{-# SPECIALIZE withResourceTimeout :: Int -> P.Pool a -> (a -> IO b) -> IO (Maybe b) #-}
+{-# SPECIALIZE withResourceTimeout :: Int -> Pool a -> (a -> IO b) -> IO (Maybe b) #-}
 withResourceTimeout ms pool act = control $ \runInIO -> mask $ \restore -> do
-    mres <- timeout ms $ P.takeResource pool
+    mres <- timeout ms $ takeResource pool
     case mres of
         Nothing -> runInIO $ return Nothing
         Just (resource, local) -> do
             ret <- restore (runInIO (liftM Just $ act resource)) `onException`
-                    P.destroyResource pool local resource
-            P.putResource local resource
+                    destroyResource pool local resource
+            putResource local resource
             return ret
 {-# INLINABLE withResourceTimeout #-}
 
 runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
-runSqlConn (SqlPersistT r) conn = do
+runSqlConn r conn = do
     let getter = getStmtConn conn
     liftBase $ connBegin conn getter
     x <- onException
@@ -60,8 +67,8 @@
 runSqlPersistMPool :: SqlPersistM a -> Pool Connection -> IO a
 runSqlPersistMPool x pool = runResourceT $ runNoLoggingT $ runSqlPool x pool
 
-withSqlPool :: MonadIO m
-            => IO Connection -- ^ create a new connection
+withSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
+            => (LogFunc -> IO Connection) -- ^ create a new connection
             -> Int -- ^ connection count
             -> (Pool Connection -> m a)
             -> m a
@@ -69,15 +76,28 @@
     pool <- createSqlPool mkConn connCount
     f pool
 
-createSqlPool :: MonadIO m
-              => IO Connection
+createSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
+              => (LogFunc -> IO Connection)
               -> Int
               -> m (Pool Connection)
-createSqlPool mkConn = liftIO . createPool mkConn close' 1 20
+createSqlPool mkConn size = do
+    logFunc <- askLogFunc
+    liftIO $ createPool (mkConn logFunc) close' 1 20 size
 
-withSqlConn :: (MonadIO m, MonadBaseControl IO m)
-            => IO Connection -> (Connection -> m a) -> m a
-withSqlConn open = bracket (liftIO open) (liftIO . close')
+-- NOTE: This function is a terrible, ugly hack. It would be much better to
+-- just clean up monad-logger.
+askLogFunc :: (MonadBaseControl IO m, MonadLogger m) => m LogFunc
+askLogFunc = do
+    runInBase <- control $ \run -> run $ return run
+    return $ \a b c d -> do
+        _ <- runInBase (monadLoggerLog a b c d)
+        return ()
+
+withSqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
+            => (LogFunc -> IO Connection) -> (Connection -> m a) -> m a
+withSqlConn open f = do
+    logFunc <- askLogFunc
+    bracket (liftIO $ open logFunc) (liftIO . close') f
 
 close' :: Connection -> IO ()
 close' conn = do
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
@@ -10,32 +10,26 @@
 module Database.Persist.Sql.Types where
 
 import Control.Exception (Exception)
-import Control.Monad.Trans.Resource (MonadResource (..), MonadThrow (..), ResourceT)
-#if MIN_VERSION_exceptions(0,6,0)
-import Control.Monad.Catch (MonadCatch, MonadMask)
-#endif
-import Control.Monad.Logger (MonadLogger (..), NoLoggingT)
+import Control.Monad.Trans.Resource (MonadResource (..), ResourceT)
+import Data.Acquire (Acquire)
+import Control.Monad.Logger (NoLoggingT)
 import Control.Monad.Trans.Control
-import Control.Monad.Trans.Class (MonadTrans (..))
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Trans.Reader (ReaderT (..))
-import Control.Applicative (Applicative (..))
 import Control.Monad.Trans.Writer (WriterT)
-import Control.Monad.Base (MonadBase (..))
-import Control.Monad (MonadPlus (..))
 import Data.Typeable (Typeable)
 import Control.Monad (liftM)
 import Database.Persist.Types
-import Data.Text (Text, pack)
-import qualified Data.Text as T
+import Database.Persist.Class (HasPersistBackend (..))
 import Data.IORef (IORef)
 import Data.Map (Map)
 import Data.Int (Int64)
 import Data.Conduit (Source)
 import Data.Pool (Pool)
-import Web.PathPieces
-import Control.Exception (throw)
-import qualified Data.Text.Read
+import Language.Haskell.TH.Syntax (Loc)
+import Control.Monad.Logger (LogSource, LogLevel)
+import System.Log.FastLogger (LogStr)
+import Data.Text (Text)
 
 data InsertSqlResult = ISRSingle Text
                      | ISRInsertGet Text Text
@@ -44,13 +38,13 @@
 data Connection = Connection
     { connPrepare :: Text -> IO Statement
     -- | table name, column names, id name, either 1 or 2 statements to run
-    , connInsertSql :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult
+    , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
     , connStmtMap :: IORef (Map Text Statement)
     , connClose :: IO ()
     , connMigrateSql
-        :: [EntityDef SqlType]
+        :: [EntityDef]
         -> (Text -> IO Statement)
-        -> EntityDef SqlType
+        -> EntityDef
         -> IO (Either [Text] [(Bool, Text)])
     , connBegin :: (Text -> IO Statement) -> IO ()
     , connCommit :: (Text -> IO Statement) -> IO ()
@@ -59,15 +53,21 @@
     , connNoLimit :: Text
     , connRDBMS :: Text
     , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
+    , connLogFunc :: LogFunc
     }
+    deriving Typeable
+instance HasPersistBackend Connection Connection where
+    persistBackend = id
 
+type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
+
 data Statement = Statement
     { stmtFinalize :: IO ()
     , stmtReset :: IO ()
     , stmtExecute :: [PersistValue] -> IO Int64
-    , stmtQuery :: forall m. MonadResource m
+    , stmtQuery :: forall m. MonadIO m
                 => [PersistValue]
-                -> Source m [PersistValue]
+                -> Acquire (Source m [PersistValue])
     }
 
 data Column = Column
@@ -86,71 +86,23 @@
     deriving (Typeable, Show)
 instance Exception PersistentSqlException
 
-data SqlBackend
-    deriving Typeable
+type SqlBackend = Connection -- FIXME
 
-newtype SqlPersistT m a = SqlPersistT { unSqlPersistT :: ReaderT Connection m a }
-    deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPlus
-#if MIN_VERSION_exceptions(0,6,0)
-#if MIN_VERSION_resourcet(1,1,0)
-        , MonadThrow
-        , MonadCatch
-        , MonadMask
-#endif
-#endif
-    )
+type SqlPersistT = ReaderT Connection -- FIXME rename connection
 
 type SqlPersist = SqlPersistT
 {-# DEPRECATED SqlPersist "Please use SqlPersistT instead" #-}
 
 type SqlPersistM = SqlPersistT (NoLoggingT (ResourceT IO))
 
-#if MIN_VERSION_resourcet(1,1,0)
-#if !MIN_VERSION_exceptions(0,6,0)
-instance MonadThrow m => MonadThrow (SqlPersistT m) where
-    throwM = lift . throwM
-#endif
-
-#else
-instance MonadThrow m => MonadThrow (SqlPersistT m) where
-    monadThrow = lift . monadThrow
-#endif
-
-instance MonadBase backend m => MonadBase backend (SqlPersistT m) where
-    liftBase = lift . liftBase
-
-instance MonadBaseControl backend m => MonadBaseControl backend (SqlPersistT m) where
-     newtype StM (SqlPersistT m) a = StMSP {unStMSP :: ComposeSt SqlPersistT m a}
-     liftBaseWith = defaultLiftBaseWith StMSP
-     restoreM     = defaultRestoreM   unStMSP
-instance MonadTransControl SqlPersistT where
-    newtype StT SqlPersistT a = StReader {unStReader :: a}
-    liftWith f = SqlPersistT $ ReaderT $ \r -> f $ \t -> liftM StReader $ runReaderT (unSqlPersistT t) r
-    restoreT = SqlPersistT . ReaderT . const . liftM unStReader
-
-instance MonadResource m => MonadResource (SqlPersistT m) where
-    liftResourceT = lift . liftResourceT
-
-instance MonadLogger m => MonadLogger (SqlPersistT m) where
-    monadLoggerLog a b c = lift . monadLoggerLog a b c
-
 type Sql = Text
 
 -- Bool indicates if the Sql is safe
 type CautiousMigration = [(Bool, Sql)]
 
-type Migration m = WriterT [Text] (WriterT CautiousMigration m) ()
+type Migration = WriterT [Text] (WriterT CautiousMigration (ReaderT Connection IO)) ()
 
 type ConnectionPool = Pool Connection
-
-instance PathPiece (KeyBackend SqlBackend entity) where
-    toPathPiece (Key (PersistInt64 i)) = toPathPiece i
-    toPathPiece k = throw $ PersistInvalidField $ pack $ "Invalid Key: " ++ show k
-    fromPathPiece t =
-        case Data.Text.Read.signed Data.Text.Read.decimal t of
-            Right (i, t') | T.null t' -> Just $ Key $ PersistInt64 i
-            _ -> Nothing
-
 
 -- $rawSql
 --
diff --git a/Database/Persist/Types/Base.hs b/Database/Persist/Types/Base.hs
--- a/Database/Persist/Types/Base.hs
+++ b/Database/Persist/Types/Base.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Database.Persist.Types.Base where
 
 import qualified Data.Aeson as A
@@ -24,7 +25,6 @@
 import Data.Bits (shiftL, shiftR)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
-import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC, zonedTimeToLocalTime, zonedTimeZone)
 import Data.Map (Map)
 import qualified Data.HashMap.Strict as HM
 import Data.Word (Word32)
@@ -105,12 +105,12 @@
                  | ByNullableAttr
                   deriving (Eq, Show)
 
-data EntityDef sqlType = EntityDef
+data EntityDef = EntityDef
     { entityHaskell :: !HaskellName
     , entityDB      :: !DBName
     , entityID      :: !DBName
     , entityAttrs   :: ![Attr]
-    , entityFields  :: ![FieldDef sqlType]
+    , entityFields  :: ![FieldDef]
     , entityPrimary :: Maybe PrimaryDef
     , entityUniques :: ![UniqueDef]
     , entityForeigns:: ![ForeignDef]
@@ -118,7 +118,7 @@
     , entityExtra   :: !(Map Text [ExtraLine])
     , entitySum     :: !Bool
     }
-    deriving (Show, Eq, Read, Ord, Functor)
+    deriving (Show, Eq, Read, Ord)
 
 type ExtraLine = [Text]
 
@@ -136,17 +136,53 @@
     | FTList FieldType
   deriving (Show, Eq, Read, Ord)
 
-data FieldDef sqlType = FieldDef
-    { fieldHaskell  :: !HaskellName -- ^ name of the field
-    , fieldDB       :: !DBName
-    , fieldType     :: !FieldType
-    , fieldSqlType  :: !sqlType
-    , fieldAttrs    :: ![Attr]   -- ^ user annotations for a field
-    , fieldStrict   :: !Bool      -- ^ a strict field in the data type. Default: true
-    , fieldEmbedded :: Maybe (EntityDef ()) -- ^ indicates that the field uses an embedded entity
+data FieldDef = FieldDef
+    { fieldHaskell   :: !HaskellName -- ^ name of the field
+    , fieldDB        :: !DBName
+    , fieldType      :: !FieldType
+    , fieldSqlType   :: !SqlType
+    , fieldAttrs     :: ![Attr]   -- ^ user annotations for a field
+    , fieldStrict    :: !Bool      -- ^ a strict field in the data type. Default: true
+    , fieldReference :: !ReferenceDef
     }
-    deriving (Show, Eq, Read, Ord, Functor)
+    deriving (Show, Eq, Read, Ord)
 
+data ReferenceDef = ForeignRef !HaskellName
+                  | EmbedRef EmbedEntityDef
+                  | NoReference
+                  deriving (Show, Eq, Read, Ord)
+
+-- | An EmbedEntityDef is the same as an EntityDef
+-- But it is only used for fieldReference
+-- so it only has data needed for embedding
+data EmbedEntityDef = EmbedEntityDef
+    { embeddedHaskell :: !HaskellName
+    , embeddedFields  :: ![EmbedFieldDef]
+    } deriving (Show, Eq, Read, Ord)
+
+-- | An EmbedFieldDef is the same as a FieldDef
+-- But it is only used for embeddedFields
+-- so it only has data needed for embedding
+data EmbedFieldDef = EmbedFieldDef
+    { emFieldDB       :: !DBName
+    , emFieldEmbed :: Maybe EmbedEntityDef
+    }
+    deriving (Show, Eq, Read, Ord)
+
+toEmbedEntityDef :: EntityDef -> EmbedEntityDef
+toEmbedEntityDef ent = EmbedEntityDef
+  { embeddedHaskell = entityHaskell ent
+  , embeddedFields = map toEmbedFieldDef $ entityFields ent
+  }
+
+toEmbedFieldDef :: FieldDef -> EmbedFieldDef
+toEmbedFieldDef field =
+  EmbedFieldDef { emFieldDB       = fieldDB field
+                   , emFieldEmbed = case fieldReference field of
+                       EmbedRef em -> Just em
+                       _ -> Nothing
+                   }
+
 data UniqueDef = UniqueDef
     { uniqueHaskell :: !HaskellName
     , uniqueDBName  :: !DBName
@@ -156,7 +192,7 @@
     deriving (Show, Eq, Read, Ord)
 
 data PrimaryDef = PrimaryDef
-    { primaryFields  :: ![(HaskellName, DBName)]
+    { primaryFields  :: ![FieldDef]
     , primaryAttrs   :: ![Attr]
     }
     deriving (Show, Eq, Read, Ord)
@@ -184,14 +220,6 @@
 instance Error PersistException where
     strMsg = PersistError . pack
 
--- | Avoid orphan instances.
-newtype ZT = ZT ZonedTime deriving (Show, Read, Typeable)
-
-instance Eq ZT where
-    ZT a /= ZT b = zonedTimeToLocalTime a /= zonedTimeToLocalTime b || zonedTimeZone a /= zonedTimeZone b
-instance Ord ZT where
-    ZT a `compare` ZT b = zonedTimeToUTC a `compare` zonedTimeToUTC b
-
 -- | A raw value which can be stored in any backend and can be marshalled to
 -- and from a 'PersistField'.
 data PersistValue = PersistText Text
@@ -203,7 +231,6 @@
                   | PersistDay Day
                   | PersistTimeOfDay TimeOfDay
                   | PersistUTCTime UTCTime
-                  | PersistZonedTime ZT
                   | PersistNull
                   | PersistList [PersistValue]
                   | PersistMap [(Text, PersistValue)]
@@ -247,10 +274,10 @@
                     _ -> Just $ PersistText t
     toPathPiece x =
         case fromPersistValueText x of
-            Left e -> error e
+            Left e -> error $ T.unpack e
             Right y -> y
 
-fromPersistValueText :: PersistValue -> Either String Text
+fromPersistValueText :: PersistValue -> Either Text Text
 fromPersistValueText (PersistText s) = Right s
 fromPersistValueText (PersistByteString bs) =
     Right $ TE.decodeUtf8With lenientDecode bs
@@ -260,7 +287,6 @@
 fromPersistValueText (PersistDay d) = Right $ T.pack $ show d
 fromPersistValueText (PersistTimeOfDay d) = Right $ T.pack $ show d
 fromPersistValueText (PersistUTCTime d) = Right $ T.pack $ show d
-fromPersistValueText (PersistZonedTime (ZT z)) = Right $ T.pack $ show z
 fromPersistValueText PersistNull = Left "Unexpected null"
 fromPersistValueText (PersistBool b) = Right $ T.pack $ show b
 fromPersistValueText (PersistList _) = Left "Cannot convert PersistList to Text"
@@ -283,7 +309,6 @@
     toJSON (PersistBool b) = A.Bool b
     toJSON (PersistTimeOfDay t) = A.String $ T.pack $ 't' : show t
     toJSON (PersistUTCTime u) = A.String $ T.pack $ 'u' : show u
-    toJSON (PersistZonedTime z) = A.String $ T.pack $ 'z' : show z
     toJSON (PersistDay d) = A.String $ T.pack $ 'd' : show d
     toJSON PersistNull = A.Null
     toJSON (PersistList l) = A.Array $ V.fromList $ map A.toJSON l
@@ -317,7 +342,6 @@
                            $ B64.decode $ TE.encodeUtf8 t
             Just ('t', t) -> fmap PersistTimeOfDay $ readMay t
             Just ('u', t) -> fmap PersistUTCTime $ readMay t
-            Just ('z', t) -> fmap PersistZonedTime $ readMay t
             Just ('d', t) -> fmap PersistDay $ readMay t
             Just ('r', t) -> fmap PersistRational $ readMay t
             Just ('o', t) -> maybe (fail "Invalid base64") (return . PersistObjectId) $
@@ -367,33 +391,29 @@
              | SqlBool
              | SqlDay
              | SqlTime
-             | SqlDayTime
-             | SqlDayTimeZoned
+             | SqlDayTime -- ^ Always uses UTC timezone
              | SqlBlob
              | SqlOther T.Text -- ^ a backend-specific name
     deriving (Show, Read, Eq, Typeable, Ord)
 
-newtype KeyBackend backend entity = Key { unKey :: PersistValue }
-    deriving (Show, Read, Eq, Ord)
-
-type family KeyEntity key
-type instance KeyEntity (KeyBackend backend entity) = entity
-
-instance A.ToJSON (KeyBackend backend entity) where
-    toJSON (Key val) = A.toJSON val
-
-instance A.FromJSON (KeyBackend backend entity) where
-    parseJSON = fmap Key . A.parseJSON
-
 data PersistFilter = Eq | Ne | Gt | Lt | Ge | Le | In | NotIn
                    | BackendSpecificFilter T.Text
     deriving (Read, Show)
 
-data UpdateGetException = KeyNotFound String
+data UpdateException = KeyNotFound String
+                     | UpsertError String
     deriving Typeable
-instance Show UpdateGetException where
+instance Show UpdateException where
     show (KeyNotFound key) = "Key not found during updateGet: " ++ key
-instance Exception UpdateGetException
+    show (UpsertError msg) = "Error during upsert: " ++ msg
+instance Exception UpdateException
+
+data OnlyUniqueException = OnlyUniqueException String deriving Typeable
+instance Show OnlyUniqueException where
+    show (OnlyUniqueException uniqueMsg) =
+      "Expected only one unique key, got " ++ uniqueMsg
+instance Exception OnlyUniqueException
+
 
 data PersistUpdate = Assign | Add | Subtract | Multiply | Divide -- FIXME need something else here
     deriving (Read, Show, Enum, Bounded)
diff --git a/persistent.cabal b/persistent.cabal
--- a/persistent.cabal
+++ b/persistent.cabal
@@ -1,5 +1,5 @@
 name:            persistent
-version:         1.3.3
+version:         2.0.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -28,10 +28,11 @@
                    , text                     >= 0.8
                    , containers               >= 0.2
                    , conduit                  >= 1.0
-                   , resourcet                >= 0.4
-                   , exceptions
+                   , resourcet                >= 1.1
+                   , exceptions               >= 0.6
                    , monad-control            >= 0.3
                    , lifted-base              >= 0.1
+                   , resource-pool
                    , path-pieces              >= 0.1
                    , aeson                    >= 0.5
                    , monad-logger             >= 0.3
@@ -44,8 +45,11 @@
                    , blaze-html               >= 0.5
                    , blaze-markup             >= 0.5.1
                    , silently
+                   , mtl
+                   , fast-logger              >= 2.1
                    , scientific
                    , resource-pool
+                   , tagged
 
     exposed-modules: Database.Persist
                      Database.Persist.Quasi
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -101,6 +101,3 @@
                 baz = FTTypeCon Nothing "Baz"
             parseFieldType "Foo [Bar] Baz" `shouldBe` Just (
                 foo `FTApp` bars `FTApp` baz)
-    describe "stripId" $ do
-        it "works" $
-            (parseFieldType "FooId" >>= stripId) `shouldBe` Just "Foo"