diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,15 @@
 ## Unreleased changes
 
+## 2.9.1.0
+
+* [#1145](https://github.com/yesodweb/persistent/pull/1148)
+    * Fix a bug where the `SqlType` for a shared primary key was being
+      incorrectly set to `SqlString` instead of whatever the target primary key
+      sql type was.
+* [#1151](https://github.com/yesodweb/persistent/pull/1151)
+    * Automatically generate `SymbolToField` instances for datatypes, allowing
+      `OverloadedLabels` to be used with the `EntityField` type.
+
 ## 2.9
 
 * Always use the "stock" strategy when deriving Show/Read for keys [#1106](https://github.com/yesodweb/persistent/pull/1106)
diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs
--- a/Database/Persist/TH.hs
+++ b/Database/Persist/TH.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -12,6 +13,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DeriveLift #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-fields #-}
 
 -- | This module provides the tools for defining your database schema and using
@@ -53,6 +55,7 @@
     , fieldError
     , AtLeastOneUniqueKey(..)
     , OnlyOneUniqueKey(..)
+    , pkNewtype
     ) where
 
 -- Development Tip: See persistent-template/README.md for advice on seeing generated Template Haskell code
@@ -61,7 +64,7 @@
 import Prelude hiding ((++), take, concat, splitAt, exp)
 
 import Data.Either
-import Control.Monad (forM, mzero, filterM, guard, unless)
+import Control.Monad
 import Data.Aeson
     ( ToJSON (toJSON), FromJSON (parseJSON), (.=), object
     , Value (Object), (.:), (.:?)
@@ -81,7 +84,7 @@
 import Data.Maybe (isJust, listToMaybe, mapMaybe, fromMaybe)
 import Data.Monoid ((<>), mappend, mconcat)
 import Data.Proxy (Proxy (Proxy))
-import Data.Text (pack, Text, append, unpack, concat, uncons, cons, stripPrefix, stripSuffix)
+import Data.Text (pack, Text, append, unpack, concat, uncons, cons, stripSuffix)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text.Encoding as TE
@@ -90,7 +93,7 @@
 import Instances.TH.Lift ()
     -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
     -- instance on pre-1.2.4 versions of `text`
-import Language.Haskell.TH.Lib (conT, varE, varP)
+import Language.Haskell.TH.Lib (appT, varT, conT, varE, varP, conE, litT, strTyLit)
 import Language.Haskell.TH.Quote
 import Language.Haskell.TH.Syntax
 import Web.PathPieces (PathPiece(..))
@@ -290,7 +293,10 @@
 
 instance Lift FieldSqlTypeExp where
     lift (FieldSqlTypeExp FieldDef{..} sqlTypeExp) =
-        [|FieldDef fieldHaskell fieldDB fieldType $(lift sqlTypeExp) fieldAttrs fieldStrict fieldReference fieldComments|]
+        [|FieldDef fieldHaskell fieldDB fieldType $(lift sqlTypeExp) fieldAttrs fieldStrict fieldReference fieldCascade fieldComments fieldGenerated|]
+      where
+        FieldDef _x _ _ _ _ _ _ _ _ _ =
+            error "need to update this record wildcard match"
 #if MIN_VERSION_template_haskell(2,16,0)
     liftTyped = unsafeTExpCoerce . lift
 #endif
@@ -323,14 +329,29 @@
 constructEntityMap =
     M.fromList . fmap (\ent -> (entityHaskell ent, ent))
 
-data FTTypeConDescr = FTKeyCon deriving Show
+data FTTypeConDescr = FTKeyCon
+    deriving Show
 
-mEmbedded :: EmbedEntityMap -> FieldType -> Either (Maybe FTTypeConDescr) EmbedEntityDef
-mEmbedded _ (FTTypeCon Just{} _) = Left Nothing
-mEmbedded ents (FTTypeCon Nothing n) =
-    let name = HaskellName n
-     in maybe (Left Nothing) Right $ M.lookup name ents
-mEmbedded ents (FTList x) = mEmbedded ents x
+-- | Recurses through the 'FieldType'. Returns a 'Right' with the
+-- 'EmbedEntityDef' if the 'FieldType' corresponds to an unqualified use of
+-- a name and that name is present in the 'EmbedEntityMap' provided as
+-- a first argument.
+--
+-- If the 'FieldType' represents a @Key something@, this returns a @'Left
+-- ('Just' 'FTKeyCon')@.
+--
+-- If the 'FieldType' has a module qualified value, then it returns @'Left'
+-- 'Nothing'@.
+mEmbedded
+    :: EmbedEntityMap
+    -> FieldType
+    -> Either (Maybe FTTypeConDescr) EmbedEntityDef
+mEmbedded _ (FTTypeCon Just{} _) =
+    Left Nothing
+mEmbedded ents (FTTypeCon Nothing (HaskellName -> name)) =
+    maybe (Left Nothing) Right $ M.lookup name ents
+mEmbedded ents (FTList x) =
+    mEmbedded ents x
 mEmbedded ents (FTApp x y) =
     -- Key converts an Record to a RecordId
     -- special casing this is obviously a hack
@@ -347,13 +368,17 @@
                 case mEmbedded allEntities (fieldType field) of
                     Left _ ->
                         case stripId $ fieldType field of
-                            Nothing -> NoReference
+                            Nothing ->
+                                NoReference
                             Just name ->
                                 case M.lookup (HaskellName name) allEntities of
-                                    Nothing -> NoReference
-                                    Just _ -> ForeignRef (HaskellName name)
-                                        -- This can get corrected in mkEntityDefSqlTypeExp
-                                        (FTTypeCon (Just "Data.Int") "Int64")
+                                    Nothing ->
+                                        NoReference
+                                    Just _ ->
+                                        ForeignRef
+                                            (HaskellName name)
+                                            -- This can get corrected in mkEntityDefSqlTypeExp
+                                            (FTTypeCon (Just "Data.Int") "Int64")
                     Right em ->
                         if embeddedHaskell em /= entName
                              then EmbedRef em
@@ -362,7 +387,8 @@
                         else case fieldType field of
                                  FTList _ -> SelfReference
                                  _ -> error $ unpack $ unHaskellName entName <> ": a self reference must be a Maybe"
-            existing -> existing
+            existing ->
+                existing
   }
 
 mkEntityDefSqlTypeExp :: EmbedEntityMap -> EntityMap -> EntityDef -> EntityDefSqlTypeExp
@@ -373,38 +399,45 @@
         maybe
             (defaultSqlTypeExp field)
             (SqlType' . SqlOther)
-            (listToMaybe $ mapMaybe (stripPrefix "sqltype=") $ fieldAttrs field)
+            (listToMaybe $ mapMaybe (\case {FieldAttrSqltype x -> Just x; _ -> Nothing}) $ fieldAttrs field)
 
     -- In the case of embedding, there won't be any datatype created yet.
     -- We just use SqlString, as the data will be serialized to JSON.
     defaultSqlTypeExp field =
         case mEmbedded emEntities ftype of
-            Right _ -> SqlType' SqlString
-            Left (Just FTKeyCon) -> SqlType' SqlString
-            Left Nothing -> case fieldReference field of
-                ForeignRef refName ft  -> case M.lookup refName entityMap of
-                    Nothing  -> SqlTypeExp ft
-                    -- A ForeignRef is blindly set to an Int64 in setEmbedField
-                    -- correct that now
-                    Just ent' -> case entityPrimary ent' of
-                        Nothing -> SqlTypeExp ft
-                        Just pdef -> case compositeFields pdef of
-                            [] -> error "mkEntityDefSqlTypeExp: no composite fields"
-                            [x] -> SqlTypeExp $ fieldType x
-                            _ -> SqlType' $ SqlOther "Composite Reference"
-                CompositeRef _  -> SqlType' $ SqlOther "Composite Reference"
-                _ ->
-                    case ftype of
-                        -- In the case of lists, we always serialize to a string
-                        -- value (via JSON).
-                        --
-                        -- Normally, this would be determined automatically by
-                        -- SqlTypeExp. However, there's one corner case: if there's
-                        -- a list of entity IDs, the datatype for the ID has not
-                        -- yet been created, so the compiler will fail. This extra
-                        -- clause works around this limitation.
-                        FTList _ -> SqlType' SqlString
-                        _ -> SqlTypeExp ftype
+            Right _ ->
+                SqlType' SqlString
+            Left (Just FTKeyCon) ->
+                SqlType' SqlString
+            Left Nothing ->
+                case fieldReference field of
+                    ForeignRef refName ft ->
+                        case M.lookup refName entityMap of
+                            Nothing  -> SqlTypeExp ft
+                            -- A ForeignRef is blindly set to an Int64 in setEmbedField
+                            -- correct that now
+                            Just ent' ->
+                                case entityPrimary ent' of
+                                    Nothing -> SqlTypeExp ft
+                                    Just pdef ->
+                                        case compositeFields pdef of
+                                            [] -> error "mkEntityDefSqlTypeExp: no composite fields"
+                                            [x] -> SqlTypeExp $ fieldType x
+                                            _ -> SqlType' $ SqlOther "Composite Reference"
+                    CompositeRef _ ->
+                        SqlType' $ SqlOther "Composite Reference"
+                    _ ->
+                        case ftype of
+                            -- In the case of lists, we always serialize to a string
+                            -- value (via JSON).
+                            --
+                            -- Normally, this would be determined automatically by
+                            -- SqlTypeExp. However, there's one corner case: if there's
+                            -- a list of entity IDs, the datatype for the ID has not
+                            -- yet been created, so the compiler will fail. This extra
+                            -- clause works around this limitation.
+                            FTList _ -> SqlType' SqlString
+                            _ -> SqlTypeExp ftype
         where
             ftype = fieldType field
 
@@ -412,12 +445,17 @@
 -- 'EntityDef's. Works well with the persist quasi-quoter.
 mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec]
 mkPersist mps ents' = do
-    requireExtensions [[TypeFamilies], [GADTs, ExistentialQuantification]]
+    requireExtensions
+        [ [TypeFamilies], [GADTs, ExistentialQuantification]
+        , [DerivingStrategies], [GeneralizedNewtypeDeriving], [StandaloneDeriving]
+        , [UndecidableInstances], [DataKinds], [FlexibleInstances]
+        ]
     x <- fmap Data.Monoid.mconcat $ mapM (persistFieldFromEntity mps) ents
     y <- fmap mconcat $ mapM (mkEntity entityMap mps) ents
     z <- fmap mconcat $ mapM (mkJSON mps) ents
     uniqueKeyInstances <- fmap mconcat $ mapM (mkUniqueKeyInstances mps) ents
-    return $ mconcat [x, y, z, uniqueKeyInstances]
+    symbolToFieldInstances <- fmap mconcat $ mapM (mkSymbolToFieldInstances mps) ents
+    return $ mconcat [x, y, z, uniqueKeyInstances, symbolToFieldInstances]
   where
     ents = map fixEntityDef ents'
     entityMap = constructEntityMap ents
@@ -428,8 +466,8 @@
 fixEntityDef ed =
     ed { entityFields = filter keepField $ entityFields ed }
   where
-    keepField fd = "MigrationOnly" `notElem` fieldAttrs fd &&
-                   "SafeToRemove" `notElem` fieldAttrs fd
+    keepField fd = FieldAttrMigrationOnly `notElem` fieldAttrs fd &&
+                   FieldAttrSafeToRemove `notElem` fieldAttrs fd
 
 -- | Settings to be passed to the 'mkPersist' function.
 data MkPersistSettings = MkPersistSettings
@@ -984,6 +1022,9 @@
 keyText :: EntityDef -> Text
 keyText t = unHaskellName (entityHaskell t) ++ "Key"
 
+-- | Returns 'True' if the key definition has more than 1 field.
+--
+-- @since 2.11.0.0
 pkNewtype :: MkPersistSettings -> EntityDef -> Bool
 pkNewtype mps t = length (keyFields mps t) < 2
 
@@ -1104,11 +1145,11 @@
     fpv <- mkFromPersistValues mps t
     utv <- mkUniqueToValues $ entityUniques t
     puk <- mkUniqueKeys t
+    let primaryField = entityId t
+    fields <- mapM (mkField mps t) $ primaryField : entityFields t
     fkc <- mapM (mkForeignKeysComposite mps t) $ entityForeigns t
 
-    let primaryField = entityId t
 
-    fields <- mapM (mkField mps t) $ primaryField : entityFields t
     toFieldNames <- mkToFieldNames $ entityUniques t
 
     (keyTypeDec, keyInstanceDecs) <- mkKeyTypeDec mps t
@@ -1131,8 +1172,7 @@
         case entityPrimary t of
             Just prim -> do
                 recordName <- newName "record"
-                let fields = map fieldHaskell (compositeFields prim)
-                    keyCon = keyConName t
+                let keyCon = keyConName t
                     keyFields' =
                         map (mkName . T.unpack . recName mps entName . fieldHaskell)
                             (compositeFields prim)
@@ -1335,7 +1375,8 @@
         ]
 
 mkForeignKeysComposite :: MkPersistSettings -> EntityDef -> ForeignDef -> Q [Dec]
-mkForeignKeysComposite mps t ForeignDef {..} = do
+mkForeignKeysComposite mps t ForeignDef {..} =
+    if not foreignToPrimary then return [] else do
     let fieldName f = mkName $ unpack $ recName mps (entityHaskell t) f
     let fname = fieldName foreignConstraintNameHaskell
     let reftableString = unpack $ unHaskellName foreignRefTableHaskell
@@ -1343,8 +1384,12 @@
     let tablename = mkName $ unpack $ entityText t
     recordName <- newName "record"
 
-    let fldsE = map (\((foreignName, _),_) -> VarE (fieldName foreignName)
-                  `AppE` VarE recordName) foreignFields
+    let mkFldE ((foreignName, _),ff) = case ff of
+          (HaskellName {unHaskellName = "Id"}, DBName {unDBName = "id"})
+            -> AppE (VarE $ mkName "toBackendKey") $
+               VarE (fieldName foreignName) `AppE` VarE recordName
+          _ -> VarE (fieldName foreignName) `AppE` VarE recordName
+    let fldsE = map mkFldE foreignFields
     let mkKeyE = foldl' AppE (maybeExp foreignNullable $ ConE reftableKeyName) fldsE
     let fn = FunD fname [normalClause [VarP recordName] mkKeyE]
 
@@ -1677,7 +1722,7 @@
     [|EntityDef
         entityHaskell
         entityDB
-        entityId
+        $(liftAndFixKey entityMap entityId)
         entityAttrs
         $(ListE <$> mapM (liftAndFixKey entityMap) entityFields)
         entityUniques
@@ -1689,23 +1734,28 @@
     |]
 
 liftAndFixKey :: EntityMap -> FieldDef -> Q Exp
-liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef mcomments) =
-    [|FieldDef a b c $(sqlTyp') e f fieldRef' mcomments|]
+liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef fc mcomments fg) =
+    [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg|]
   where
-    (fieldRef', sqlTyp') = fromMaybe (fieldRef, lift sqlTyp) $
-      case fieldRef of
-        ForeignRef refName _ft -> case M.lookup refName entityMap of
-          Nothing -> Nothing
-          Just ent ->
-            case fieldReference $ entityId ent of
-              fr@(ForeignRef _Name ft) -> Just (fr, lift $ SqlTypeExp ft)
-              _ -> Nothing
-        _ -> Nothing
+    (fieldRef', sqlTyp') =
+        fromMaybe (fieldRef, lift sqlTyp) $
+            case fieldRef of
+                ForeignRef refName _ft ->  do
+                    ent <- M.lookup refName entityMap
+                    case fieldReference $ entityId ent of
+                        fr@(ForeignRef _ ft) ->
+                            Just (fr, lift $ SqlTypeExp ft)
+                        _ ->
+                            Nothing
+                _ ->
+                    Nothing
 
 deriving instance Lift EntityDef
 
 deriving instance Lift FieldDef
 
+deriving instance Lift FieldAttr
+
 deriving instance Lift UniqueDef
 
 deriving instance Lift CompositeDef
@@ -1906,7 +1956,32 @@
         , GeneralizedNewtypeDeriving
         , StandaloneDeriving
         , UndecidableInstances
+        , MultiParamTypeClasses
         ]
+
+mkSymbolToFieldInstances :: MkPersistSettings -> EntityDef -> Q [Dec]
+mkSymbolToFieldInstances mps ed = do
+    fmap join $ forM (entityFields ed) $ \fieldDef -> do
+        let fieldNameT =
+                litT $ strTyLit $ T.unpack $ unHaskellName $ fieldHaskell fieldDef
+                    :: Q Type
+            nameG = mkName $ unpack $ unHaskellName (entityHaskell ed) ++ "Generic"
+
+            recordNameT
+                | mpsGeneric mps =
+                    conT nameG `appT` varT backendName
+                | otherwise =
+                    conT $ mkName $ T.unpack $ unHaskellName $ entityHaskell ed
+            fieldTypeT =
+                maybeIdType mps fieldDef Nothing Nothing
+            entityFieldConstr =
+                conE $ filterConName mps ed fieldDef
+                    :: Q Exp
+        [d|
+            instance SymbolToField $(fieldNameT) $(recordNameT) $(pure fieldTypeT) where
+                symbolToField = $(entityFieldConstr)
+
+            |]
 
 -- | Pass in a list of lists of extensions, where any of the given
 -- extensions will satisfy it. For example, you might need either GADTs or
diff --git a/persistent-template.cabal b/persistent-template.cabal
--- a/persistent-template.cabal
+++ b/persistent-template.cabal
@@ -1,5 +1,5 @@
 name:            persistent-template
-version:         2.9
+version:         2.9.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -37,7 +37,12 @@
     type:            exitcode-stdio-1.0
     main-is:         main.hs
     hs-source-dirs:  test
-    other-modules:   TemplateTestImports
+    other-modules:   
+        TemplateTestImports
+      , SharedPrimaryKeyTest
+      , SharedPrimaryKeyTestImported
+      , OverloadedLabelTest
+                    
     ghc-options:     -Wall
 
     build-depends:   base                     >= 4.10 && < 5
diff --git a/test/OverloadedLabelTest.hs b/test/OverloadedLabelTest.hs
new file mode 100644
--- /dev/null
+++ b/test/OverloadedLabelTest.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedLabels           #-}
+{-# LANGUAGE PartialTypeSignatures      #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
+
+module OverloadedLabelTest where
+
+import           TemplateTestImports
+
+mkPersist sqlSettings [persistUpperCase|
+
+User
+    name    String
+    age     Int
+
+Dog
+    userId  UserId
+    name    String
+    age     Int
+
+Organization
+    name    String
+
+|]
+
+spec :: Spec
+spec = describe "OverloadedLabels" $ do
+    it "works for monomorphic labels" $ do
+        let UserName = #name
+            OrganizationName = #name
+            DogName = #name
+
+        compiles
+
+    it "works for polymorphic labels" $ do
+        let name :: _ => EntityField rec a
+            name = #name
+
+            UserName = name
+            OrganizationName = name
+            DogName = name
+
+        compiles
+
+compiles :: Expectation
+compiles = True `shouldBe` True
diff --git a/test/SharedPrimaryKeyTest.hs b/test/SharedPrimaryKeyTest.hs
new file mode 100644
--- /dev/null
+++ b/test/SharedPrimaryKeyTest.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE TypeApplications, DeriveGeneric #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DataKinds, FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module SharedPrimaryKeyTest where
+
+import TemplateTestImports
+
+import Data.Proxy
+import Test.Hspec
+import Database.Persist
+import Database.Persist.Sql
+import Database.Persist.Sql.Util
+import Database.Persist.TH
+
+share [ mkPersist sqlSettings ] [persistLowerCase|
+
+User
+    name    String
+
+-- TODO: uncomment this out https://github.com/yesodweb/persistent/issues/1149
+-- Profile
+--     Id      UserId
+--     email   String
+
+Profile
+    Id      (Key User)
+    email   String
+
+|]
+
+spec :: Spec
+spec = describe "Shared Primary Keys" $ do
+
+    describe "PersistFieldSql" $ do
+        it "should match underlying key" $ do
+            sqlType (Proxy @UserId)
+                `shouldBe`
+                    sqlType (Proxy @ProfileId)
+
+    describe "entityId FieldDef" $ do
+        it "should match underlying primary key" $ do
+            let getSqlType :: PersistEntity a => Proxy a -> SqlType
+                getSqlType =
+                    fieldSqlType . entityId . entityDef
+            getSqlType (Proxy @User)
+                `shouldBe`
+                    getSqlType (Proxy @Profile)
diff --git a/test/SharedPrimaryKeyTestImported.hs b/test/SharedPrimaryKeyTestImported.hs
new file mode 100644
--- /dev/null
+++ b/test/SharedPrimaryKeyTestImported.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE TypeApplications, DeriveGeneric #-}
+{-# LANGUAGE DataKinds, ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module SharedPrimaryKeyTestImported where
+
+import TemplateTestImports
+
+import Data.Proxy
+import Test.Hspec
+import Database.Persist
+import Database.Persist.Sql
+import Database.Persist.Sql.Util
+import Database.Persist.TH
+
+import SharedPrimaryKeyTest (User, UserId)
+
+share [ mkPersist sqlSettings ] [persistLowerCase|
+
+Profile
+    Id      UserId
+    email   String
+
+|]
+
+-- This test is very similar to the one in SharedPrimaryKeyTest, but it is
+-- able to use 'UserId' directly, since the type is imported from another
+-- module.
+spec :: Spec
+spec = describe "Shared Primary Keys Imported" $ do
+
+    describe "PersistFieldSql" $ do
+        it "should match underlying key" $ do
+            sqlType (Proxy @UserId)
+                `shouldBe`
+                    sqlType (Proxy @ProfileId)
+
+    describe "entityId FieldDef" $ do
+        it "should match underlying primary key" $ do
+            let getSqlType :: PersistEntity a => Proxy a -> SqlType
+                getSqlType =
+                    fieldSqlType . entityId . entityDef
+            getSqlType (Proxy @User)
+                `shouldBe`
+                    getSqlType (Proxy @Profile)
diff --git a/test/TemplateTestImports.hs b/test/TemplateTestImports.hs
--- a/test/TemplateTestImports.hs
+++ b/test/TemplateTestImports.hs
@@ -1,10 +1,16 @@
 {-# LANGUAGE TemplateHaskell #-}
-module TemplateTestImports where
 
+module TemplateTestImports
+    ( module TemplateTestImports
+    , module X
+    ) where
+
 import Data.Aeson.TH
 import Test.QuickCheck
 
-import Database.Persist.TH
+import Test.Hspec as X
+import Database.Persist.Sql as X
+import Database.Persist.TH as X
 
 data Foo = Bar | Baz
     deriving (Show, Eq)
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeApplications, DeriveGeneric, RecordWildCards #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -10,6 +10,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# language DataKinds #-}
 
 -- DeriveAnyClass is not actually used by persistent-template
 -- But a long standing bug was that if it was enabled, it was used to derive instead of GeneralizedNewtypeDeriving
@@ -23,6 +24,8 @@
     module Main
   ) where
 
+import Data.Int
+import Data.Proxy
 import Control.Applicative (Const (..))
 import Data.Aeson
 import Data.ByteString.Lazy.Char8 ()
@@ -33,20 +36,32 @@
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Gen (Gen)
 import GHC.Generics (Generic)
+import qualified Data.List as List
+import Data.Coerce
 
 import Database.Persist
 import Database.Persist.Sql
+import Database.Persist.Sql.Util
 import Database.Persist.TH
 import TemplateTestImports
 
+import qualified SharedPrimaryKeyTest
+import qualified SharedPrimaryKeyTestImported
+import qualified OverloadedLabelTest
 
 share [mkPersist sqlSettings { mpsGeneric = False, mpsDeriveInstances = [''Generic] }, mkDeleteCascade sqlSettings { mpsGeneric = False }] [persistUpperCase|
+
 Person json
     name Text
     age Int Maybe
     foo Foo
     address Address
     deriving Show Eq
+
+HasSimpleCascadeRef
+    person PersonId OnDeleteCascade
+    deriving Show Eq
+
 Address json
     street Text
     city Text
@@ -57,9 +72,41 @@
     deriving Show Eq
 |]
 
--- TODO: Derive Generic at the source site to get this unblocked.
-deriving instance Generic (BackendKey SqlBackend)
+mkPersist sqlSettings [persistLowerCase|
+HasPrimaryDef
+    userId Int
+    name String
+    Primary userId
 
+HasMultipleColPrimaryDef
+    foobar Int
+    barbaz String
+    Primary foobar barbaz
+
+HasIdDef
+    Id Int
+    name String
+
+HasDefaultId
+    name String
+
+HasCustomSqlId
+    Id String sql=my_id
+    name String
+
+SharedPrimaryKey
+    Id (Key HasDefaultId)
+    name String
+
+SharedPrimaryKeyWithCascade
+    Id (Key HasDefaultId) OnDeleteCascade
+    name String
+
+SharedPrimaryKeyWithCascadeAndCustomName
+    Id (Key HasDefaultId) OnDeleteCascade sql=my_id
+    name String
+|]
+
 share [mkPersist sqlSettings { mpsGeneric = False, mpsGenerateLenses = True }] [persistLowerCase|
 Lperson json
     name Text
@@ -81,11 +128,204 @@
 
 instance Arbitrary Person where
     arbitrary = Person <$> arbitraryT <*> arbitrary <*> arbitrary <*> arbitrary
+
 instance Arbitrary Address where
     arbitrary = Address <$> arbitraryT <*> arbitraryT <*> arbitrary
 
 main :: IO ()
 main = hspec $ do
+    OverloadedLabelTest.spec
+    SharedPrimaryKeyTest.spec
+    SharedPrimaryKeyTestImported.spec
+    describe "HasDefaultId" $ do
+        let FieldDef{..} =
+                entityId (entityDef (Proxy @HasDefaultId))
+        it "should have usual db name" $ do
+            fieldDB `shouldBe` DBName "id"
+        it "should have usual haskell name" $ do
+            fieldHaskell `shouldBe` HaskellName "Id"
+        it "should have correct underlying sql type" $ do
+            fieldSqlType `shouldBe` SqlInt64
+        it "persistfieldsql should be right" $ do
+            sqlType (Proxy @HasDefaultIdId) `shouldBe` SqlInt64
+        it "should have correct haskell type" $ do
+            fieldType `shouldBe` FTTypeCon Nothing "HasDefaultIdId"
+
+    describe "HasCustomSqlId" $ do
+        let FieldDef{..} =
+                entityId (entityDef (Proxy @HasCustomSqlId))
+        it "should have custom db name" $ do
+            fieldDB `shouldBe` DBName "my_id"
+        it "should have usual haskell name" $ do
+            fieldHaskell `shouldBe` HaskellName "id"
+        it "should have correct underlying sql type" $ do
+            fieldSqlType `shouldBe` SqlString
+        it "should have correct haskell type" $ do
+            fieldType `shouldBe` FTTypeCon Nothing "String"
+    describe "HasIdDef" $ do
+        let FieldDef{..} =
+                entityId (entityDef (Proxy @HasIdDef))
+        it "should have usual db name" $ do
+            fieldDB `shouldBe` DBName "id"
+        it "should have usual haskell name" $ do
+            fieldHaskell `shouldBe` HaskellName "id"
+        it "should have correct underlying sql type" $ do
+            fieldSqlType `shouldBe` SqlInt64
+        it "should have correct haskell type" $ do
+            fieldType `shouldBe` FTTypeCon Nothing "Int"
+
+    describe "SharedPrimaryKey" $ do
+        let sharedDef = entityDef (Proxy @SharedPrimaryKey)
+            FieldDef{..} =
+                entityId sharedDef
+        it "should have usual db name" $ do
+            fieldDB `shouldBe` DBName "id"
+        it "should have usual haskell name" $ do
+            fieldHaskell `shouldBe` HaskellName "id"
+        it "should have correct underlying sql type" $ do
+            fieldSqlType `shouldBe` SqlInt64
+        it "should have correct haskell type" $ do
+            fieldType `shouldBe` FTApp (FTTypeCon Nothing "Key") (FTTypeCon Nothing "HasDefaultId")
+        it "should have correct sql type from PersistFieldSql" $ do
+            sqlType (Proxy @SharedPrimaryKeyId)
+                `shouldBe`
+                    SqlInt64
+        it "should have same sqlType as underlying record" $ do
+            sqlType (Proxy @SharedPrimaryKeyId)
+                `shouldBe`
+                    sqlType (Proxy @HasDefaultIdId)
+        it "should be a coercible newtype" $ do
+            coerce @Int64 3
+                `shouldBe`
+                    SharedPrimaryKeyKey (toSqlKey 3)
+
+        it "is a newtype" $ do
+            pkNewtype sqlSettings sharedDef
+                `shouldBe`
+                    True
+
+    describe "SharedPrimaryKeyWithCascade" $ do
+        let FieldDef{..} =
+                entityId (entityDef (Proxy @SharedPrimaryKeyWithCascade))
+        it "should have usual db name" $ do
+            fieldDB `shouldBe` DBName "id"
+        it "should have usual haskell name" $ do
+            fieldHaskell `shouldBe` HaskellName "id"
+        it "should have correct underlying sql type" $ do
+            fieldSqlType `shouldBe` SqlInt64
+        it "should have correct haskell type" $ do
+            fieldType
+                `shouldBe`
+                    FTApp (FTTypeCon Nothing "Key") (FTTypeCon Nothing "HasDefaultId")
+        it "should have cascade in field def" $ do
+            fieldCascade `shouldBe` noCascade { fcOnDelete = Just Cascade }
+
+    describe "OnCascadeDelete" $ do
+        let subject :: FieldDef
+            Just subject =
+                List.find ((HaskellName "person" ==) . fieldHaskell)
+                $ entityFields
+                $ simpleCascadeDef
+            simpleCascadeDef =
+                entityDef (Proxy :: Proxy HasSimpleCascadeRef)
+            expected =
+                FieldCascade
+                    { fcOnDelete = Just Cascade
+                    , fcOnUpdate = Nothing
+                    }
+        describe "entityDef" $ do
+            it "works" $ do
+                simpleCascadeDef
+                    `shouldBe`
+                        EntityDef
+                            { entityHaskell = HaskellName "HasSimpleCascadeRef"
+                            , entityDB = DBName "HasSimpleCascadeRef"
+                            , entityId =
+                                FieldDef
+                                    { fieldHaskell = HaskellName "Id"
+                                    , fieldDB = DBName "id"
+                                    , fieldType = FTTypeCon Nothing "HasSimpleCascadeRefId"
+                                    , fieldSqlType = SqlInt64
+                                    , fieldReference =
+                                        ForeignRef (HaskellName "HasSimpleCascadeRef") (FTTypeCon (Just "Data.Int") "Int64")
+                                    , fieldAttrs = []
+                                    , fieldStrict = True
+                                    , fieldComments = Nothing
+                                    , fieldCascade = noCascade
+                                    , fieldGenerated = Nothing
+                                    }
+                            , entityAttrs = []
+                            , entityFields =
+                                [ FieldDef
+                                    { fieldHaskell = HaskellName "person"
+                                    , fieldDB = DBName "person"
+                                    , fieldType = FTTypeCon Nothing "PersonId"
+                                    , fieldSqlType = SqlInt64
+                                    , fieldAttrs = []
+                                    , fieldStrict = True
+                                    , fieldReference =
+                                        ForeignRef
+                                            (HaskellName "Person")
+                                            (FTTypeCon (Just "Data.Int") "Int64")
+                                    , fieldCascade =
+                                        FieldCascade { fcOnUpdate = Nothing, fcOnDelete = Just Cascade }
+                                    , fieldComments = Nothing
+                                    , fieldGenerated = Nothing
+                                    }
+                                ]
+                            , entityUniques = []
+                            , entityForeigns = []
+                            , entityDerives =  ["Show", "Eq"]
+                            , entityExtra = mempty
+                            , entitySum = False
+                            , entityComments = Nothing
+                            }
+        it "has the cascade on the field def" $ do
+            fieldCascade subject `shouldBe` expected
+        it "doesn't have any extras" $ do
+            entityExtra simpleCascadeDef
+                `shouldBe`
+                    mempty
+
+    describe "hasNaturalKey" $ do
+        let subject :: PersistEntity a => Proxy a -> Bool
+            subject p = hasNaturalKey (entityDef p)
+        it "is True for Primary keyword" $ do
+            subject (Proxy @HasPrimaryDef)
+                `shouldBe`
+                    True
+        it "is True for multiple Primary columns " $ do
+            subject (Proxy @HasMultipleColPrimaryDef)
+                `shouldBe`
+                    True
+        it "is False for Id keyword" $ do
+            subject (Proxy @HasIdDef)
+                `shouldBe`
+                    False
+        it "is False for unspecified/default id" $ do
+            subject (Proxy @HasDefaultId)
+                `shouldBe`
+                    False
+    describe "hasCompositePrimaryKey" $ do
+        let subject :: PersistEntity a => Proxy a -> Bool
+            subject p = hasCompositePrimaryKey (entityDef p)
+        it "is False for Primary with single column" $ do
+            subject (Proxy @HasPrimaryDef)
+                `shouldBe`
+                    False
+        it "is True for multiple Primary columns " $ do
+            subject (Proxy @HasMultipleColPrimaryDef)
+                `shouldBe`
+                    True
+        it "is False for Id keyword" $ do
+            subject (Proxy @HasIdDef)
+                `shouldBe`
+                    False
+        it "is False for unspecified/default id" $ do
+            subject (Proxy @HasDefaultId)
+                `shouldBe`
+                    False
+
     describe "JSON serialization" $ do
         prop "to/from is idempotent" $ \person ->
             decode (encode person) == Just (person :: Person)