{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-identities #-}

-- | Work with SQLite database used for caches across a single project.

module Stack.Storage.Project
    ( initProjectStorage
    , ConfigCacheKey
    , configCacheKey
    , loadConfigCache
    , saveConfigCache
    , deactiveConfigCache
    ) where

import qualified Data.ByteString as S
import qualified Data.Set as Set
import           Database.Persist.Sqlite
import           Database.Persist.TH
import qualified Pantry.Internal as SQLite
import           Path
import           Stack.Prelude
import           Stack.Storage.Util
                   ( handleMigrationException, updateList, updateSet )
import           Stack.Types.Build
import           Stack.Types.Cache
import           Stack.Types.Config
                   ( HasBuildConfig, ProjectStorage (..), bcProjectStorage
                   , buildConfigL
                   )
import           Stack.Types.GhcPkgId

share [ mkPersist sqlSettings
      , mkMigrate "migrateAll"
    ]
    [persistLowerCase|
ConfigCacheParent sql="config_cache"
  directory FilePath "default=(hex(randomblob(16)))"
  type ConfigCacheType
  pkgSrc CachePkgSrc
  active Bool
  pathEnvVar Text
  haddock Bool default=0
  UniqueConfigCacheParent directory type sql="unique_config_cache"
  deriving Show

ConfigCacheDirOption
  parent ConfigCacheParentId sql="config_cache_id" OnDeleteCascade
  index Int
  value String sql="option"
  UniqueConfigCacheDirOption parent index
  deriving Show

ConfigCacheNoDirOption
  parent ConfigCacheParentId sql="config_cache_id" OnDeleteCascade
  index Int
  value String sql="option"
  UniqueConfigCacheNoDirOption parent index
  deriving Show

ConfigCacheDep
  parent ConfigCacheParentId sql="config_cache_id" OnDeleteCascade
  value GhcPkgId sql="ghc_pkg_id"
  UniqueConfigCacheDep parent value
  deriving Show

ConfigCacheComponent
  parent ConfigCacheParentId sql="config_cache_id" OnDeleteCascade
  value S.ByteString sql="component"
  UniqueConfigCacheComponent parent value
  deriving Show
|]

-- | Initialize the database.

initProjectStorage ::
       HasLogFunc env
    => Path Abs File -- ^ storage file

    -> (ProjectStorage -> RIO env a)
    -> RIO env a
initProjectStorage :: forall env a.
HasLogFunc env =>
Path Abs File -> (ProjectStorage -> RIO env a) -> RIO env a
initProjectStorage Path Abs File
fp ProjectStorage -> RIO env a
f = forall env a. HasLogFunc env => RIO env a -> RIO env a
handleMigrationException forall a b. (a -> b) -> a -> b
$
    forall env a.
HasLogFunc env =>
Text
-> Migration
-> Path Abs File
-> (Storage -> RIO env a)
-> RIO env a
SQLite.initStorage Text
"Stack" Migration
migrateAll Path Abs File
fp forall a b. (a -> b) -> a -> b
$ ProjectStorage -> RIO env a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage -> ProjectStorage
ProjectStorage

-- | Run an action in a database transaction

withProjectStorage ::
       (HasBuildConfig env, HasLogFunc env)
    => ReaderT SqlBackend (RIO env) a
    -> RIO env a
withProjectStorage :: forall env a.
(HasBuildConfig env, HasLogFunc env) =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withProjectStorage ReaderT SqlBackend (RIO env) a
inner = do
    Storage
storage <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> ProjectStorage
bcProjectStorage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to ProjectStorage -> Storage
unProjectStorage)
    Storage
-> forall env a.
   HasLogFunc env =>
   ReaderT SqlBackend (RIO env) a -> RIO env a
SQLite.withStorage_ Storage
storage ReaderT SqlBackend (RIO env) a
inner

-- | Key used to retrieve configuration or flag cache

type ConfigCacheKey = Unique ConfigCacheParent

-- | Build key used to retrieve configuration or flag cache

configCacheKey :: Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey :: Path Abs Dir -> ConfigCacheType -> Unique ConfigCacheParent
configCacheKey Path Abs Dir
dir = String -> ConfigCacheType -> Unique ConfigCacheParent
UniqueConfigCacheParent (forall b t. Path b t -> String
toFilePath Path Abs Dir
dir)

-- | Internal helper to read the 'ConfigCache'

readConfigCache ::
       (HasBuildConfig env, HasLogFunc env)
    => Entity ConfigCacheParent
    -> ReaderT SqlBackend (RIO env) ConfigCache
readConfigCache :: forall env.
(HasBuildConfig env, HasLogFunc env) =>
Entity ConfigCacheParent
-> ReaderT SqlBackend (RIO env) ConfigCache
readConfigCache (Entity Key ConfigCacheParent
parentId ConfigCacheParent {Bool
String
Text
ConfigCacheType
CachePkgSrc
configCacheParentHaddock :: Bool
configCacheParentPathEnvVar :: Text
configCacheParentActive :: Bool
configCacheParentPkgSrc :: CachePkgSrc
configCacheParentType :: ConfigCacheType
configCacheParentDirectory :: String
configCacheParentHaddock :: ConfigCacheParent -> Bool
configCacheParentPathEnvVar :: ConfigCacheParent -> Text
configCacheParentActive :: ConfigCacheParent -> Bool
configCacheParentPkgSrc :: ConfigCacheParent -> CachePkgSrc
configCacheParentType :: ConfigCacheParent -> ConfigCacheType
configCacheParentDirectory :: ConfigCacheParent -> String
..}) = do
    let configCachePkgSrc :: CachePkgSrc
configCachePkgSrc = CachePkgSrc
configCacheParentPkgSrc
    [String]
coDirs <-
        forall a b. (a -> b) -> [a] -> [b]
map (ConfigCacheDirOption -> String
configCacheDirOptionValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
            [forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheDirOption typ
ConfigCacheDirOptionParent forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ConfigCacheParent
parentId]
            [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField ConfigCacheDirOption typ
ConfigCacheDirOptionIndex]
    [String]
coNoDirs <-
        forall a b. (a -> b) -> [a] -> [b]
map (ConfigCacheNoDirOption -> String
configCacheNoDirOptionValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
            [forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheNoDirOption typ
ConfigCacheNoDirOptionParent forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ConfigCacheParent
parentId]
            [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField ConfigCacheNoDirOption typ
ConfigCacheNoDirOptionIndex]
    let configCacheOpts :: ConfigureOpts
configCacheOpts = ConfigureOpts {[String]
coNoDirs :: [String]
coDirs :: [String]
coNoDirs :: [String]
coDirs :: [String]
..}
    Set GhcPkgId
configCacheDeps <-
        forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ConfigCacheDep -> GhcPkgId
configCacheDepValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheDep typ
ConfigCacheDepParent forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ConfigCacheParent
parentId] []
    Set ByteString
configCacheComponents <-
        forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ConfigCacheComponent -> ByteString
configCacheComponentValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheComponent typ
ConfigCacheComponentParent forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ConfigCacheParent
parentId] []
    let configCachePathEnvVar :: Text
configCachePathEnvVar = Text
configCacheParentPathEnvVar
    let configCacheHaddock :: Bool
configCacheHaddock = Bool
configCacheParentHaddock
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigCache {Bool
Set ByteString
Set GhcPkgId
Text
ConfigureOpts
CachePkgSrc
configCachePathEnvVar :: Text
configCachePkgSrc :: CachePkgSrc
configCacheHaddock :: Bool
configCacheComponents :: Set ByteString
configCacheDeps :: Set GhcPkgId
configCacheOpts :: ConfigureOpts
configCacheHaddock :: Bool
configCachePathEnvVar :: Text
configCacheComponents :: Set ByteString
configCacheDeps :: Set GhcPkgId
configCacheOpts :: ConfigureOpts
configCachePkgSrc :: CachePkgSrc
..}

-- | Load 'ConfigCache' from the database.

loadConfigCache ::
       (HasBuildConfig env, HasLogFunc env)
    => ConfigCacheKey
    -> RIO env (Maybe ConfigCache)
loadConfigCache :: forall env.
(HasBuildConfig env, HasLogFunc env) =>
Unique ConfigCacheParent -> RIO env (Maybe ConfigCache)
loadConfigCache Unique ConfigCacheParent
key =
    forall env a.
(HasBuildConfig env, HasLogFunc env) =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withProjectStorage forall a b. (a -> b) -> a -> b
$ do
        Maybe (Entity ConfigCacheParent)
mparent <- forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique ConfigCacheParent
key
        case Maybe (Entity ConfigCacheParent)
mparent of
            Maybe (Entity ConfigCacheParent)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            Just parentEntity :: Entity ConfigCacheParent
parentEntity@(Entity Key ConfigCacheParent
_ ConfigCacheParent {Bool
String
Text
ConfigCacheType
CachePkgSrc
configCacheParentHaddock :: Bool
configCacheParentPathEnvVar :: Text
configCacheParentActive :: Bool
configCacheParentPkgSrc :: CachePkgSrc
configCacheParentType :: ConfigCacheType
configCacheParentDirectory :: String
configCacheParentHaddock :: ConfigCacheParent -> Bool
configCacheParentPathEnvVar :: ConfigCacheParent -> Text
configCacheParentActive :: ConfigCacheParent -> Bool
configCacheParentPkgSrc :: ConfigCacheParent -> CachePkgSrc
configCacheParentType :: ConfigCacheParent -> ConfigCacheType
configCacheParentDirectory :: ConfigCacheParent -> String
..})
                | Bool
configCacheParentActive ->
                    forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasBuildConfig env, HasLogFunc env) =>
Entity ConfigCacheParent
-> ReaderT SqlBackend (RIO env) ConfigCache
readConfigCache Entity ConfigCacheParent
parentEntity
                | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Insert or update 'ConfigCache' to the database.

saveConfigCache ::
       (HasBuildConfig env, HasLogFunc env)
    => ConfigCacheKey
    -> ConfigCache
    -> RIO env ()
saveConfigCache :: forall env.
(HasBuildConfig env, HasLogFunc env) =>
Unique ConfigCacheParent -> ConfigCache -> RIO env ()
saveConfigCache key :: Unique ConfigCacheParent
key@(UniqueConfigCacheParent String
dir ConfigCacheType
type_) ConfigCache
new =
    forall env a.
(HasBuildConfig env, HasLogFunc env) =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withProjectStorage forall a b. (a -> b) -> a -> b
$ do
        Maybe (Entity ConfigCacheParent)
mparent <- forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy Unique ConfigCacheParent
key
        (Key ConfigCacheParent
parentId, Maybe ConfigCache
mold) <-
            case Maybe (Entity ConfigCacheParent)
mparent of
                Maybe (Entity ConfigCacheParent)
Nothing ->
                    (, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert
                        ConfigCacheParent
                            { configCacheParentDirectory :: String
configCacheParentDirectory = String
dir
                            , configCacheParentType :: ConfigCacheType
configCacheParentType = ConfigCacheType
type_
                            , configCacheParentPkgSrc :: CachePkgSrc
configCacheParentPkgSrc = ConfigCache -> CachePkgSrc
configCachePkgSrc ConfigCache
new
                            , configCacheParentActive :: Bool
configCacheParentActive = Bool
True
                            , configCacheParentPathEnvVar :: Text
configCacheParentPathEnvVar = ConfigCache -> Text
configCachePathEnvVar ConfigCache
new
                            , configCacheParentHaddock :: Bool
configCacheParentHaddock = ConfigCache -> Bool
configCacheHaddock ConfigCache
new
                            }
                Just parentEntity :: Entity ConfigCacheParent
parentEntity@(Entity Key ConfigCacheParent
parentId ConfigCacheParent
_) -> do
                    ConfigCache
old <- forall env.
(HasBuildConfig env, HasLogFunc env) =>
Entity ConfigCacheParent
-> ReaderT SqlBackend (RIO env) ConfigCache
readConfigCache Entity ConfigCacheParent
parentEntity
                    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update
                        Key ConfigCacheParent
parentId
                        [ forall typ.
(typ ~ CachePkgSrc) =>
EntityField ConfigCacheParent typ
ConfigCacheParentPkgSrc forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ConfigCache -> CachePkgSrc
configCachePkgSrc ConfigCache
new
                        , forall typ. (typ ~ Bool) => EntityField ConfigCacheParent typ
ConfigCacheParentActive forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Bool
True
                        , forall typ. (typ ~ Text) => EntityField ConfigCacheParent typ
ConfigCacheParentPathEnvVar forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ConfigCache -> Text
configCachePathEnvVar ConfigCache
new
                        ]
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key ConfigCacheParent
parentId, forall a. a -> Maybe a
Just ConfigCache
old)
        forall record backend parentid value (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistField parentid, Ord value, PersistEntity record, MonadIO m,
 PersistQueryWrite backend) =>
(parentid -> Int -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record Int
-> [value]
-> [value]
-> ReaderT backend m ()
updateList
            Key ConfigCacheParent -> Int -> String -> ConfigCacheDirOption
ConfigCacheDirOption
            forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheDirOption typ
ConfigCacheDirOptionParent
            Key ConfigCacheParent
parentId
            forall typ. (typ ~ Int) => EntityField ConfigCacheDirOption typ
ConfigCacheDirOptionIndex
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (ConfigureOpts -> [String]
coDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigCache -> ConfigureOpts
configCacheOpts) Maybe ConfigCache
mold)
            (ConfigureOpts -> [String]
coDirs forall a b. (a -> b) -> a -> b
$ ConfigCache -> ConfigureOpts
configCacheOpts ConfigCache
new)
        forall record backend parentid value (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistField parentid, Ord value, PersistEntity record, MonadIO m,
 PersistQueryWrite backend) =>
(parentid -> Int -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record Int
-> [value]
-> [value]
-> ReaderT backend m ()
updateList
            Key ConfigCacheParent -> Int -> String -> ConfigCacheNoDirOption
ConfigCacheNoDirOption
            forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheNoDirOption typ
ConfigCacheNoDirOptionParent
            Key ConfigCacheParent
parentId
            forall typ. (typ ~ Int) => EntityField ConfigCacheNoDirOption typ
ConfigCacheNoDirOptionIndex
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (ConfigureOpts -> [String]
coNoDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigCache -> ConfigureOpts
configCacheOpts) Maybe ConfigCache
mold)
            (ConfigureOpts -> [String]
coNoDirs forall a b. (a -> b) -> a -> b
$ ConfigCache -> ConfigureOpts
configCacheOpts ConfigCache
new)
        forall record backend parentid value (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistField parentid, PersistField value, Ord value,
 PersistEntity record, MonadIO m, PersistQueryWrite backend) =>
(parentid -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record value
-> Set value
-> Set value
-> ReaderT backend m ()
updateSet
            Key ConfigCacheParent -> GhcPkgId -> ConfigCacheDep
ConfigCacheDep
            forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheDep typ
ConfigCacheDepParent
            Key ConfigCacheParent
parentId
            forall typ. (typ ~ GhcPkgId) => EntityField ConfigCacheDep typ
ConfigCacheDepValue
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
Set.empty ConfigCache -> Set GhcPkgId
configCacheDeps Maybe ConfigCache
mold)
            (ConfigCache -> Set GhcPkgId
configCacheDeps ConfigCache
new)
        forall record backend parentid value (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistField parentid, PersistField value, Ord value,
 PersistEntity record, MonadIO m, PersistQueryWrite backend) =>
(parentid -> value -> record)
-> EntityField record parentid
-> parentid
-> EntityField record value
-> Set value
-> Set value
-> ReaderT backend m ()
updateSet
            Key ConfigCacheParent -> ByteString -> ConfigCacheComponent
ConfigCacheComponent
            forall typ.
(typ ~ Key ConfigCacheParent) =>
EntityField ConfigCacheComponent typ
ConfigCacheComponentParent
            Key ConfigCacheParent
parentId
            forall typ.
(typ ~ ByteString) =>
EntityField ConfigCacheComponent typ
ConfigCacheComponentValue
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
Set.empty ConfigCache -> Set ByteString
configCacheComponents Maybe ConfigCache
mold)
            (ConfigCache -> Set ByteString
configCacheComponents ConfigCache
new)

-- | Mark 'ConfigCache' as inactive in the database.

-- We use a flag instead of deleting the records since, in most cases, the same

-- cache will be written again within in a few seconds (after

-- `cabal configure`), so this avoids unnecessary database churn.

deactiveConfigCache :: HasBuildConfig env => ConfigCacheKey -> RIO env ()
deactiveConfigCache :: forall env.
HasBuildConfig env =>
Unique ConfigCacheParent -> RIO env ()
deactiveConfigCache (UniqueConfigCacheParent String
dir ConfigCacheType
type_) =
    forall env a.
(HasBuildConfig env, HasLogFunc env) =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withProjectStorage forall a b. (a -> b) -> a -> b
$
    forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere
        [forall typ. (typ ~ String) => EntityField ConfigCacheParent typ
ConfigCacheParentDirectory forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. String
dir, forall typ.
(typ ~ ConfigCacheType) =>
EntityField ConfigCacheParent typ
ConfigCacheParentType forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. ConfigCacheType
type_]
        [forall typ. (typ ~ Bool) => EntityField ConfigCacheParent typ
ConfigCacheParentActive forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Bool
False]