{-# LANGUAGE Arrows #-}

-- | Description: Create/delete SQL tables to/from Hasura metadata.
module Hasura.RQL.DDL.Schema.Table
  ( TrackTable (..),
    runTrackTableQ,
    TrackTableV2 (..),
    runTrackTableV2Q,
    UntrackTable (..),
    runUntrackTableQ,
    dropTableInMetadata,
    SetTableIsEnum (..),
    runSetExistingTableIsEnumQ,
    SetTableCustomFields (..),
    runSetTableCustomFieldsQV2,
    SetTableCustomization (..),
    runSetTableCustomization,
    buildTableCache,
    checkConflictingNode,
    SetApolloFederationConfig (..),
    runSetApolloFederationConfig,
  )
where

import Control.Arrow.Extended
import Control.Lens hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Ordered qualified as JO
import Data.Align (align)
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict.Extended qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as S
import Data.Text.Extended
import Data.These (These (..))
import Hasura.Backends.Postgres.SQL.Types (PGDescription (..), QualifiedTable)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Context
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Schema.Common (textToName)
import Hasura.GraphQL.Schema.NamingCase
import Hasura.Incremental qualified as Inc
import Hasura.Prelude
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Enum (resolveEnumReferences)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Eventing.Backend (BackendEventTrigger, dropTriggerAndArchiveEvents)
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization (applyFieldNameCaseCust)
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Server.Utils
import Language.GraphQL.Draft.Syntax qualified as G

data TrackTable b = TrackTable
  { TrackTable b -> SourceName
tSource :: SourceName,
    TrackTable b -> TableName b
tName :: TableName b,
    TrackTable b -> Bool
tIsEnum :: Bool,
    TrackTable b -> Maybe ApolloFederationConfig
tApolloFedConfig :: Maybe ApolloFederationConfig
  }

deriving instance (Backend b) => Show (TrackTable b)

deriving instance (Backend b) => Eq (TrackTable b)

instance (Backend b) => FromJSON (TrackTable b) where
  parseJSON :: Value -> Parser (TrackTable b)
parseJSON Value
v = Value -> Parser (TrackTable b)
withOptions Value
v Parser (TrackTable b)
-> Parser (TrackTable b) -> Parser (TrackTable b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (TrackTable b)
withoutOptions
    where
      withOptions :: Value -> Parser (TrackTable b)
withOptions = String
-> (Object -> Parser (TrackTable b))
-> Value
-> Parser (TrackTable b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TrackTable" \Object
o ->
        SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> TrackTable b
forall (b :: BackendType).
SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> TrackTable b
TrackTable
          (SourceName
 -> TableName b
 -> Bool
 -> Maybe ApolloFederationConfig
 -> TrackTable b)
-> Parser SourceName
-> Parser
     (TableName b
      -> Bool -> Maybe ApolloFederationConfig -> TrackTable b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
          Parser
  (TableName b
   -> Bool -> Maybe ApolloFederationConfig -> TrackTable b)
-> Parser (TableName b)
-> Parser (Bool -> Maybe ApolloFederationConfig -> TrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
          Parser (Bool -> Maybe ApolloFederationConfig -> TrackTable b)
-> Parser Bool
-> Parser (Maybe ApolloFederationConfig -> TrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_enum" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Parser (Maybe ApolloFederationConfig -> TrackTable b)
-> Parser (Maybe ApolloFederationConfig) -> Parser (TrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ApolloFederationConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"apollo_federation_config"
      withoutOptions :: Parser (TrackTable b)
withoutOptions = SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> TrackTable b
forall (b :: BackendType).
SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> TrackTable b
TrackTable SourceName
defaultSource (TableName b
 -> Bool -> Maybe ApolloFederationConfig -> TrackTable b)
-> Parser (TableName b)
-> Parser (Bool -> Maybe ApolloFederationConfig -> TrackTable b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (TableName b)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (Bool -> Maybe ApolloFederationConfig -> TrackTable b)
-> Parser Bool
-> Parser (Maybe ApolloFederationConfig -> TrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False Parser (Maybe ApolloFederationConfig -> TrackTable b)
-> Parser (Maybe ApolloFederationConfig) -> Parser (TrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ApolloFederationConfig
-> Parser (Maybe ApolloFederationConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ApolloFederationConfig
forall a. Maybe a
Nothing

data SetTableIsEnum = SetTableIsEnum
  { SetTableIsEnum -> SourceName
stieSource :: SourceName,
    SetTableIsEnum -> QualifiedTable
stieTable :: QualifiedTable,
    SetTableIsEnum -> Bool
stieIsEnum :: Bool
  }
  deriving (Int -> SetTableIsEnum -> ShowS
[SetTableIsEnum] -> ShowS
SetTableIsEnum -> String
(Int -> SetTableIsEnum -> ShowS)
-> (SetTableIsEnum -> String)
-> ([SetTableIsEnum] -> ShowS)
-> Show SetTableIsEnum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTableIsEnum] -> ShowS
$cshowList :: [SetTableIsEnum] -> ShowS
show :: SetTableIsEnum -> String
$cshow :: SetTableIsEnum -> String
showsPrec :: Int -> SetTableIsEnum -> ShowS
$cshowsPrec :: Int -> SetTableIsEnum -> ShowS
Show, SetTableIsEnum -> SetTableIsEnum -> Bool
(SetTableIsEnum -> SetTableIsEnum -> Bool)
-> (SetTableIsEnum -> SetTableIsEnum -> Bool) -> Eq SetTableIsEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTableIsEnum -> SetTableIsEnum -> Bool
$c/= :: SetTableIsEnum -> SetTableIsEnum -> Bool
== :: SetTableIsEnum -> SetTableIsEnum -> Bool
$c== :: SetTableIsEnum -> SetTableIsEnum -> Bool
Eq)

instance FromJSON SetTableIsEnum where
  parseJSON :: Value -> Parser SetTableIsEnum
parseJSON = String
-> (Object -> Parser SetTableIsEnum)
-> Value
-> Parser SetTableIsEnum
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetTableIsEnum" ((Object -> Parser SetTableIsEnum)
 -> Value -> Parser SetTableIsEnum)
-> (Object -> Parser SetTableIsEnum)
-> Value
-> Parser SetTableIsEnum
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> QualifiedTable -> Bool -> SetTableIsEnum
SetTableIsEnum
      (SourceName -> QualifiedTable -> Bool -> SetTableIsEnum)
-> Parser SourceName
-> Parser (QualifiedTable -> Bool -> SetTableIsEnum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (QualifiedTable -> Bool -> SetTableIsEnum)
-> Parser QualifiedTable -> Parser (Bool -> SetTableIsEnum)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (Bool -> SetTableIsEnum)
-> Parser Bool -> Parser SetTableIsEnum
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"is_enum"

data UntrackTable b = UntrackTable
  { UntrackTable b -> SourceName
utSource :: SourceName,
    UntrackTable b -> TableName b
utTable :: TableName b,
    UntrackTable b -> Bool
utCascade :: Bool
  }

deriving instance (Backend b) => Show (UntrackTable b)

deriving instance (Backend b) => Eq (UntrackTable b)

instance (Backend b) => FromJSON (UntrackTable b) where
  parseJSON :: Value -> Parser (UntrackTable b)
parseJSON = String
-> (Object -> Parser (UntrackTable b))
-> Value
-> Parser (UntrackTable b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UntrackTable" ((Object -> Parser (UntrackTable b))
 -> Value -> Parser (UntrackTable b))
-> (Object -> Parser (UntrackTable b))
-> Value
-> Parser (UntrackTable b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> Bool -> UntrackTable b
forall (b :: BackendType).
SourceName -> TableName b -> Bool -> UntrackTable b
UntrackTable
      (SourceName -> TableName b -> Bool -> UntrackTable b)
-> Parser SourceName
-> Parser (TableName b -> Bool -> UntrackTable b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> Bool -> UntrackTable b)
-> Parser (TableName b) -> Parser (Bool -> UntrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (Bool -> UntrackTable b)
-> Parser Bool -> Parser (UntrackTable b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cascade" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

isTableTracked :: forall b. (Backend b) => SourceInfo b -> TableName b -> Bool
isTableTracked :: SourceInfo b -> TableName b -> Bool
isTableTracked SourceInfo b
sourceInfo TableName b
tableName =
  Maybe (TableInfo b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (TableInfo b) -> Bool) -> Maybe (TableInfo b) -> Bool
forall a b. (a -> b) -> a -> b
$ TableName b
-> HashMap (TableName b) (TableInfo b) -> Maybe (TableInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TableName b
tableName (HashMap (TableName b) (TableInfo b) -> Maybe (TableInfo b))
-> HashMap (TableName b) (TableInfo b) -> Maybe (TableInfo b)
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables SourceInfo b
sourceInfo

-- | Track table/view, Phase 1:
-- Validate table tracking operation. Fails if table is already being tracked,
-- or if a function with the same name is being tracked.
trackExistingTableOrViewP1 ::
  forall b m.
  (QErrM m, CacheRWM m, Backend b, MetadataM m) =>
  SourceName ->
  TableName b ->
  m ()
trackExistingTableOrViewP1 :: SourceName -> TableName b -> m ()
trackExistingTableOrViewP1 SourceName
source TableName b
tableName = do
  SourceInfo b
sourceInfo <- SourceName -> m (SourceInfo b)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo SourceName
source
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SourceInfo b -> TableName b -> Bool
forall (b :: BackendType).
Backend b =>
SourceInfo b -> TableName b -> Bool
isTableTracked @b SourceInfo b
sourceInfo TableName b
tableName) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyTracked (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"view/table already tracked : " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
  let functionName :: FunctionName b
functionName = TableName b -> FunctionName b
forall (b :: BackendType).
Backend b =>
TableName b -> FunctionName b
tableToFunction @b TableName b
tableName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (FunctionInfo b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (FunctionInfo b) -> Bool) -> Maybe (FunctionInfo b) -> Bool
forall a b. (a -> b) -> a -> b
$ FunctionName b
-> HashMap (FunctionName b) (FunctionInfo b)
-> Maybe (FunctionInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FunctionName b
functionName (HashMap (FunctionName b) (FunctionInfo b)
 -> Maybe (FunctionInfo b))
-> HashMap (FunctionName b) (FunctionInfo b)
-> Maybe (FunctionInfo b)
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap (FunctionName b) (FunctionInfo b)
forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siFunctions @b SourceInfo b
sourceInfo) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"function with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists"

-- | Check whether a given name would conflict with the current schema by doing
-- an internal introspection
checkConflictingNode ::
  forall m.
  MonadError QErr m =>
  SchemaCache ->
  Text ->
  m ()
checkConflictingNode :: SchemaCache -> Text -> m ()
checkConflictingNode SchemaCache
sc Text
tnGQL = do
  let GQLContext ParserFn (RootFieldMap (QueryRootField UnpreparedValue))
queryParser Maybe (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
_ Maybe (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
_ = SchemaCache -> GQLContext
scUnauthenticatedGQLContext SchemaCache
sc
      -- {
      --   __schema {
      --     queryType {
      --       fields {
      --         name
      --       }
      --     }
      --   }
      -- }
      introspectionQuery :: [Selection frag var]
introspectionQuery =
        [ Field frag var -> Selection frag var
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field frag var -> Selection frag var)
-> Field frag var -> Selection frag var
forall a b. (a -> b) -> a -> b
$
            Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> [Selection frag var]
-> Field frag var
forall (frag :: * -> *) var.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet frag var
-> Field frag var
G.Field
              Maybe Name
forall a. Maybe a
Nothing
              Name
GName.___schema
              HashMap Name (Value var)
forall a. Monoid a => a
mempty
              []
              [ Field frag var -> Selection frag var
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field frag var -> Selection frag var)
-> Field frag var -> Selection frag var
forall a b. (a -> b) -> a -> b
$
                  Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> [Selection frag var]
-> Field frag var
forall (frag :: * -> *) var.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet frag var
-> Field frag var
G.Field
                    Maybe Name
forall a. Maybe a
Nothing
                    Name
GName._queryType
                    HashMap Name (Value var)
forall a. Monoid a => a
mempty
                    []
                    [ Field frag var -> Selection frag var
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field frag var -> Selection frag var)
-> Field frag var -> Selection frag var
forall a b. (a -> b) -> a -> b
$
                        Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> [Selection frag var]
-> Field frag var
forall (frag :: * -> *) var.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet frag var
-> Field frag var
G.Field
                          Maybe Name
forall a. Maybe a
Nothing
                          Name
GName._fields
                          HashMap Name (Value var)
forall a. Monoid a => a
mempty
                          []
                          [ Field frag var -> Selection frag var
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field frag var -> Selection frag var)
-> Field frag var -> Selection frag var
forall a b. (a -> b) -> a -> b
$
                              Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> [Selection frag var]
-> Field frag var
forall (frag :: * -> *) var.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet frag var
-> Field frag var
G.Field
                                Maybe Name
forall a. Maybe a
Nothing
                                Name
GName._name
                                HashMap Name (Value var)
forall a. Monoid a => a
mempty
                                []
                                []
                          ]
                    ]
              ]
        ]
  case ParserFn (RootFieldMap (QueryRootField UnpreparedValue))
queryParser [Selection NoFragments Variable]
forall (frag :: * -> *) var. [Selection frag var]
introspectionQuery of
    Left QErr
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right RootFieldMap (QueryRootField UnpreparedValue)
results -> do
      case RootFieldAlias
-> RootFieldMap (QueryRootField UnpreparedValue)
-> Maybe (QueryRootField UnpreparedValue)
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.lookup (Name -> RootFieldAlias
mkUnNamespacedRootFieldAlias Name
GName.___schema) RootFieldMap (QueryRootField UnpreparedValue)
results of
        Just (RFRaw (JO.Object Object
schema)) -> do
          let names :: Maybe (Vector Text)
names = do
                JO.Object Object
queryType <- Text -> Object -> Maybe Value
JO.lookup Text
"queryType" Object
schema
                JO.Array Array
fields <- Text -> Object -> Maybe Value
JO.lookup Text
"fields" Object
queryType
                Array -> (Value -> Maybe Text) -> Maybe (Vector Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Array
fields \case
                  JO.Object Object
field -> do
                    JO.String Text
name <- Text -> Object -> Maybe Value
JO.lookup Text
"name" Object
field
                    Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
                  Value
_ -> Maybe Text
forall a. Maybe a
Nothing
          case Maybe (Vector Text)
names of
            Maybe (Vector Text)
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just Vector Text
ns ->
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
tnGQL Text -> Vector Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Text
ns) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaConflicts (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                  Text
"node " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tnGQL
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists in current graphql schema"
        Maybe (QueryRootField UnpreparedValue)
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

trackExistingTableOrViewP2 ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  SourceName ->
  TableName b ->
  Bool ->
  TableConfig b ->
  Maybe ApolloFederationConfig ->
  m EncJSON
trackExistingTableOrViewP2 :: SourceName
-> TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> m EncJSON
trackExistingTableOrViewP2 SourceName
source TableName b
tableName Bool
isEnum TableConfig b
config Maybe ApolloFederationConfig
apolloFedConfig = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  {-
  The next line does more than what it says on the tin.  Removing the following
  call to 'checkConflictingNode' causes memory usage to spike when newly
  tracking a large amount (~100) of tables.  The memory usage can be triggered
  by first creating a large amount of tables through SQL, without tracking the
  tables, and then clicking "track all" in the console.  Curiously, this high
  memory usage happens even when no substantial GraphQL schema is generated.
  -}
  SchemaCache -> Text -> m ()
forall (m :: * -> *).
MonadError QErr m =>
SchemaCache -> Text -> m ()
checkConflictingNode SchemaCache
sc (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ TableName b -> Text
forall (b :: BackendType). Backend b => TableName b -> Text
snakeCaseTableName @b TableName b
tableName
  let metadata :: TableMetadata b
metadata = (Maybe ApolloFederationConfig
 -> Identity (Maybe ApolloFederationConfig))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Maybe ApolloFederationConfig)
tmApolloFederationConfig ((Maybe ApolloFederationConfig
  -> Identity (Maybe ApolloFederationConfig))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe ApolloFederationConfig
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ApolloFederationConfig
apolloFedConfig (TableMetadata b -> TableMetadata b)
-> TableMetadata b -> TableMetadata b
forall a b. (a -> b) -> a -> b
$ TableName b -> Bool -> TableConfig b -> TableMetadata b
forall (b :: BackendType).
TableName b -> Bool -> TableConfig b -> TableMetadata b
mkTableMeta TableName b
tableName Bool
isEnum TableConfig b
config
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
        SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
          TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
tableName
    )
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> Sources -> Identity Sources)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (TableName b) (TableMetadata b)
 -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType). Lens' (SourceMetadata b) (Tables b)
smTables ((InsOrdHashMap (TableName b) (TableMetadata b)
  -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> InsOrdHashMap (TableName b) (TableMetadata b))
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableName b
-> TableMetadata b
-> InsOrdHashMap (TableName b) (TableMetadata b)
-> InsOrdHashMap (TableName b) (TableMetadata b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert TableName b
tableName TableMetadata b
metadata
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runTrackTableQ ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  TrackTable b ->
  m EncJSON
runTrackTableQ :: TrackTable b -> m EncJSON
runTrackTableQ (TrackTable SourceName
source TableName b
qt Bool
isEnum Maybe ApolloFederationConfig
apolloFedConfig) = do
  SourceName -> TableName b -> m ()
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewP1 @b SourceName
source TableName b
qt
  SourceName
-> TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> m EncJSON
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
SourceName
-> TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> m EncJSON
trackExistingTableOrViewP2 @b SourceName
source TableName b
qt Bool
isEnum TableConfig b
forall (b :: BackendType). TableConfig b
emptyTableConfig Maybe ApolloFederationConfig
apolloFedConfig

data TrackTableV2 b = TrackTableV2
  { TrackTableV2 b -> TrackTable b
ttv2Table :: TrackTable b,
    TrackTableV2 b -> TableConfig b
ttv2Configuration :: TableConfig b
  }
  deriving (Int -> TrackTableV2 b -> ShowS
[TrackTableV2 b] -> ShowS
TrackTableV2 b -> String
(Int -> TrackTableV2 b -> ShowS)
-> (TrackTableV2 b -> String)
-> ([TrackTableV2 b] -> ShowS)
-> Show (TrackTableV2 b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> TrackTableV2 b -> ShowS
forall (b :: BackendType). Backend b => [TrackTableV2 b] -> ShowS
forall (b :: BackendType). Backend b => TrackTableV2 b -> String
showList :: [TrackTableV2 b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [TrackTableV2 b] -> ShowS
show :: TrackTableV2 b -> String
$cshow :: forall (b :: BackendType). Backend b => TrackTableV2 b -> String
showsPrec :: Int -> TrackTableV2 b -> ShowS
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> TrackTableV2 b -> ShowS
Show, TrackTableV2 b -> TrackTableV2 b -> Bool
(TrackTableV2 b -> TrackTableV2 b -> Bool)
-> (TrackTableV2 b -> TrackTableV2 b -> Bool)
-> Eq (TrackTableV2 b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> TrackTableV2 b -> Bool
/= :: TrackTableV2 b -> TrackTableV2 b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> TrackTableV2 b -> Bool
== :: TrackTableV2 b -> TrackTableV2 b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> TrackTableV2 b -> Bool
Eq)

instance (Backend b) => FromJSON (TrackTableV2 b) where
  parseJSON :: Value -> Parser (TrackTableV2 b)
parseJSON = String
-> (Object -> Parser (TrackTableV2 b))
-> Value
-> Parser (TrackTableV2 b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TrackTableV2" ((Object -> Parser (TrackTableV2 b))
 -> Value -> Parser (TrackTableV2 b))
-> (Object -> Parser (TrackTableV2 b))
-> Value
-> Parser (TrackTableV2 b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TrackTable b
table <- Value -> Parser (TrackTable b)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (TrackTable b)) -> Value -> Parser (TrackTable b)
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
o
    TableConfig b
configuration <- Object
o Object -> Key -> Parser (Maybe (TableConfig b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"configuration" Parser (Maybe (TableConfig b))
-> TableConfig b -> Parser (TableConfig b)
forall a. Parser (Maybe a) -> a -> Parser a
.!= TableConfig b
forall (b :: BackendType). TableConfig b
emptyTableConfig
    TrackTableV2 b -> Parser (TrackTableV2 b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TrackTableV2 b -> Parser (TrackTableV2 b))
-> TrackTableV2 b -> Parser (TrackTableV2 b)
forall a b. (a -> b) -> a -> b
$ TrackTable b -> TableConfig b -> TrackTableV2 b
forall (b :: BackendType).
TrackTable b -> TableConfig b -> TrackTableV2 b
TrackTableV2 TrackTable b
table TableConfig b
configuration

runTrackTableV2Q ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  TrackTableV2 b ->
  m EncJSON
runTrackTableV2Q :: TrackTableV2 b -> m EncJSON
runTrackTableV2Q (TrackTableV2 (TrackTable SourceName
source TableName b
qt Bool
isEnum Maybe ApolloFederationConfig
apolloFedConfig) TableConfig b
config) = do
  SourceName -> TableName b -> m ()
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewP1 @b SourceName
source TableName b
qt
  SourceName
-> TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> m EncJSON
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
SourceName
-> TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> m EncJSON
trackExistingTableOrViewP2 @b SourceName
source TableName b
qt Bool
isEnum TableConfig b
config Maybe ApolloFederationConfig
apolloFedConfig

runSetExistingTableIsEnumQ :: (MonadError QErr m, CacheRWM m, MetadataM m) => SetTableIsEnum -> m EncJSON
runSetExistingTableIsEnumQ :: SetTableIsEnum -> m EncJSON
runSetExistingTableIsEnumQ (SetTableIsEnum SourceName
source QualifiedTable
tableName Bool
isEnum) = do
  m (TableInfo ('Postgres 'Vanilla)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo ('Postgres 'Vanilla)) -> m ())
-> m (TableInfo ('Postgres 'Vanilla)) -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @('Postgres 'Vanilla) SourceName
source TableName ('Postgres 'Vanilla)
QualifiedTable
tableName -- assert that table is tracked
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    (SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId ('Postgres 'Vanilla)
-> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId ('Postgres 'Vanilla)
 -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId ('Postgres 'Vanilla)
-> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> SourceMetadataObjId ('Postgres 'Vanilla)
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @('Postgres 'Vanilla) TableName ('Postgres 'Vanilla)
QualifiedTable
tableName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName
-> TableName ('Postgres 'Vanilla)
-> ASetter' Metadata (TableMetadata ('Postgres 'Vanilla))
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @('Postgres 'Vanilla) SourceName
source TableName ('Postgres 'Vanilla)
QualifiedTable
tableName ASetter' Metadata (TableMetadata ('Postgres 'Vanilla))
-> ((Bool -> Identity Bool)
    -> TableMetadata ('Postgres 'Vanilla)
    -> Identity (TableMetadata ('Postgres 'Vanilla)))
-> (Bool -> Identity Bool)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> TableMetadata ('Postgres 'Vanilla)
-> Identity (TableMetadata ('Postgres 'Vanilla))
forall (b :: BackendType). Lens' (TableMetadata b) Bool
tmIsEnum ((Bool -> Identity Bool) -> Metadata -> Identity Metadata)
-> Bool -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
isEnum
  EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

data SetTableCustomization b = SetTableCustomization
  { SetTableCustomization b -> SourceName
_stcSource :: SourceName,
    SetTableCustomization b -> TableName b
_stcTable :: TableName b,
    SetTableCustomization b -> TableConfig b
_stcConfiguration :: TableConfig b
  }
  deriving (Int -> SetTableCustomization b -> ShowS
[SetTableCustomization b] -> ShowS
SetTableCustomization b -> String
(Int -> SetTableCustomization b -> ShowS)
-> (SetTableCustomization b -> String)
-> ([SetTableCustomization b] -> ShowS)
-> Show (SetTableCustomization b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> SetTableCustomization b -> ShowS
forall (b :: BackendType).
Backend b =>
[SetTableCustomization b] -> ShowS
forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> String
showList :: [SetTableCustomization b] -> ShowS
$cshowList :: forall (b :: BackendType).
Backend b =>
[SetTableCustomization b] -> ShowS
show :: SetTableCustomization b -> String
$cshow :: forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> String
showsPrec :: Int -> SetTableCustomization b -> ShowS
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> SetTableCustomization b -> ShowS
Show, SetTableCustomization b -> SetTableCustomization b -> Bool
(SetTableCustomization b -> SetTableCustomization b -> Bool)
-> (SetTableCustomization b -> SetTableCustomization b -> Bool)
-> Eq (SetTableCustomization b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> SetTableCustomization b -> Bool
/= :: SetTableCustomization b -> SetTableCustomization b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> SetTableCustomization b -> Bool
== :: SetTableCustomization b -> SetTableCustomization b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> SetTableCustomization b -> Bool
Eq)

instance (Backend b) => FromJSON (SetTableCustomization b) where
  parseJSON :: Value -> Parser (SetTableCustomization b)
parseJSON = String
-> (Object -> Parser (SetTableCustomization b))
-> Value
-> Parser (SetTableCustomization b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetTableCustomization" ((Object -> Parser (SetTableCustomization b))
 -> Value -> Parser (SetTableCustomization b))
-> (Object -> Parser (SetTableCustomization b))
-> Value
-> Parser (SetTableCustomization b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b -> TableConfig b -> SetTableCustomization b
forall (b :: BackendType).
SourceName
-> TableName b -> TableConfig b -> SetTableCustomization b
SetTableCustomization
      (SourceName
 -> TableName b -> TableConfig b -> SetTableCustomization b)
-> Parser SourceName
-> Parser (TableName b -> TableConfig b -> SetTableCustomization b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> TableConfig b -> SetTableCustomization b)
-> Parser (TableName b)
-> Parser (TableConfig b -> SetTableCustomization b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (TableConfig b -> SetTableCustomization b)
-> Parser (TableConfig b) -> Parser (SetTableCustomization b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableConfig b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"configuration"

data SetTableCustomFields = SetTableCustomFields
  { SetTableCustomFields -> SourceName
_stcfSource :: SourceName,
    SetTableCustomFields -> QualifiedTable
_stcfTable :: QualifiedTable,
    SetTableCustomFields -> TableCustomRootFields
_stcfCustomRootFields :: TableCustomRootFields,
    SetTableCustomFields -> HashMap (Column ('Postgres 'Vanilla)) Name
_stcfCustomColumnNames :: HashMap (Column ('Postgres 'Vanilla)) G.Name
  }
  deriving (Int -> SetTableCustomFields -> ShowS
[SetTableCustomFields] -> ShowS
SetTableCustomFields -> String
(Int -> SetTableCustomFields -> ShowS)
-> (SetTableCustomFields -> String)
-> ([SetTableCustomFields] -> ShowS)
-> Show SetTableCustomFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTableCustomFields] -> ShowS
$cshowList :: [SetTableCustomFields] -> ShowS
show :: SetTableCustomFields -> String
$cshow :: SetTableCustomFields -> String
showsPrec :: Int -> SetTableCustomFields -> ShowS
$cshowsPrec :: Int -> SetTableCustomFields -> ShowS
Show, SetTableCustomFields -> SetTableCustomFields -> Bool
(SetTableCustomFields -> SetTableCustomFields -> Bool)
-> (SetTableCustomFields -> SetTableCustomFields -> Bool)
-> Eq SetTableCustomFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTableCustomFields -> SetTableCustomFields -> Bool
$c/= :: SetTableCustomFields -> SetTableCustomFields -> Bool
== :: SetTableCustomFields -> SetTableCustomFields -> Bool
$c== :: SetTableCustomFields -> SetTableCustomFields -> Bool
Eq)

instance FromJSON SetTableCustomFields where
  parseJSON :: Value -> Parser SetTableCustomFields
parseJSON = String
-> (Object -> Parser SetTableCustomFields)
-> Value
-> Parser SetTableCustomFields
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetTableCustomFields" ((Object -> Parser SetTableCustomFields)
 -> Value -> Parser SetTableCustomFields)
-> (Object -> Parser SetTableCustomFields)
-> Value
-> Parser SetTableCustomFields
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> QualifiedTable
-> TableCustomRootFields
-> HashMap (Column ('Postgres 'Vanilla)) Name
-> SetTableCustomFields
SourceName
-> QualifiedTable
-> TableCustomRootFields
-> HashMap PGCol Name
-> SetTableCustomFields
SetTableCustomFields
      (SourceName
 -> QualifiedTable
 -> TableCustomRootFields
 -> HashMap PGCol Name
 -> SetTableCustomFields)
-> Parser SourceName
-> Parser
     (QualifiedTable
      -> TableCustomRootFields
      -> HashMap PGCol Name
      -> SetTableCustomFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (QualifiedTable
   -> TableCustomRootFields
   -> HashMap PGCol Name
   -> SetTableCustomFields)
-> Parser QualifiedTable
-> Parser
     (TableCustomRootFields
      -> HashMap PGCol Name -> SetTableCustomFields)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (TableCustomRootFields
   -> HashMap PGCol Name -> SetTableCustomFields)
-> Parser TableCustomRootFields
-> Parser (HashMap PGCol Name -> SetTableCustomFields)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe TableCustomRootFields)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_root_fields" Parser (Maybe TableCustomRootFields)
-> TableCustomRootFields -> Parser TableCustomRootFields
forall a. Parser (Maybe a) -> a -> Parser a
.!= TableCustomRootFields
emptyCustomRootFields
      Parser (HashMap PGCol Name -> SetTableCustomFields)
-> Parser (HashMap PGCol Name) -> Parser SetTableCustomFields
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (HashMap PGCol Name))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_column_names" Parser (Maybe (HashMap PGCol Name))
-> HashMap PGCol Name -> Parser (HashMap PGCol Name)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap PGCol Name
forall k v. HashMap k v
Map.empty

runSetTableCustomFieldsQV2 ::
  (QErrM m, CacheRWM m, MetadataM m) => SetTableCustomFields -> m EncJSON
runSetTableCustomFieldsQV2 :: SetTableCustomFields -> m EncJSON
runSetTableCustomFieldsQV2 (SetTableCustomFields SourceName
source QualifiedTable
tableName TableCustomRootFields
rootFields HashMap (Column ('Postgres 'Vanilla)) Name
columnNames) = do
  m (TableInfo ('Postgres 'Vanilla)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo ('Postgres 'Vanilla)) -> m ())
-> m (TableInfo ('Postgres 'Vanilla)) -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @('Postgres 'Vanilla) SourceName
source TableName ('Postgres 'Vanilla)
QualifiedTable
tableName -- assert that table is tracked
  let columnConfig :: HashMap PGCol ColumnConfig
columnConfig = (\Name
name -> ColumnConfig
forall a. Monoid a => a
mempty {_ccfgCustomName :: Maybe Name
_ccfgCustomName = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name}) (Name -> ColumnConfig)
-> HashMap PGCol Name -> HashMap PGCol ColumnConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap (Column ('Postgres 'Vanilla)) Name
HashMap PGCol Name
columnNames
  let tableConfig :: TableConfig ('Postgres 'Vanilla)
tableConfig = TableCustomRootFields
-> HashMap (Column ('Postgres 'Vanilla)) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig ('Postgres 'Vanilla)
forall (b :: BackendType).
TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
TableConfig @('Postgres 'Vanilla) TableCustomRootFields
rootFields HashMap (Column ('Postgres 'Vanilla)) ColumnConfig
HashMap PGCol ColumnConfig
columnConfig Maybe Name
forall a. Maybe a
Nothing Comment
Automatic
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    (SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId ('Postgres 'Vanilla)
-> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId ('Postgres 'Vanilla)
 -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId ('Postgres 'Vanilla)
-> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> SourceMetadataObjId ('Postgres 'Vanilla)
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @('Postgres 'Vanilla) TableName ('Postgres 'Vanilla)
QualifiedTable
tableName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName
-> TableName ('Postgres 'Vanilla)
-> ASetter' Metadata (TableMetadata ('Postgres 'Vanilla))
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter SourceName
source TableName ('Postgres 'Vanilla)
QualifiedTable
tableName ASetter' Metadata (TableMetadata ('Postgres 'Vanilla))
-> ((TableConfig ('Postgres 'Vanilla)
     -> Identity (TableConfig ('Postgres 'Vanilla)))
    -> TableMetadata ('Postgres 'Vanilla)
    -> Identity (TableMetadata ('Postgres 'Vanilla)))
-> (TableConfig ('Postgres 'Vanilla)
    -> Identity (TableConfig ('Postgres 'Vanilla)))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableConfig ('Postgres 'Vanilla)
 -> Identity (TableConfig ('Postgres 'Vanilla)))
-> TableMetadata ('Postgres 'Vanilla)
-> Identity (TableMetadata ('Postgres 'Vanilla))
forall (b :: BackendType). Lens' (TableMetadata b) (TableConfig b)
tmConfiguration ((TableConfig ('Postgres 'Vanilla)
  -> Identity (TableConfig ('Postgres 'Vanilla)))
 -> Metadata -> Identity Metadata)
-> TableConfig ('Postgres 'Vanilla) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TableConfig ('Postgres 'Vanilla)
tableConfig
  EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

runSetTableCustomization ::
  forall b m.
  (QErrM m, CacheRWM m, MetadataM m, Backend b, BackendMetadata b) =>
  SetTableCustomization b ->
  m EncJSON
runSetTableCustomization :: SetTableCustomization b -> m EncJSON
runSetTableCustomization (SetTableCustomization SourceName
source TableName b
table TableConfig b
config) = do
  m (TableInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo b) -> m ()) -> m (TableInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
table
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    (SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
table)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter SourceName
source TableName b
table ASetter' Metadata (TableMetadata b)
-> ((TableConfig b -> Identity (TableConfig b))
    -> TableMetadata b -> Identity (TableMetadata b))
-> (TableConfig b -> Identity (TableConfig b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableConfig b -> Identity (TableConfig b))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType). Lens' (TableMetadata b) (TableConfig b)
tmConfiguration ((TableConfig b -> Identity (TableConfig b))
 -> Metadata -> Identity Metadata)
-> TableConfig b -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TableConfig b
config
  EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

unTrackExistingTableOrViewP1 ::
  forall b m.
  (CacheRM m, QErrM m, Backend b) =>
  UntrackTable b ->
  m ()
unTrackExistingTableOrViewP1 :: UntrackTable b -> m ()
unTrackExistingTableOrViewP1 (UntrackTable SourceName
source TableName b
vn Bool
_) = do
  SchemaCache
schemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  m (TableInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo b) -> m ()) -> m (TableInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$
    SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
unsafeTableInfo @b SourceName
source TableName b
vn (SchemaCache -> SourceCache
scSources SchemaCache
schemaCache)
      Maybe (TableInfo b) -> m (TableInfo b) -> m (TableInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (TableInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyUntracked (Text
"view/table already untracked : " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
vn)

unTrackExistingTableOrViewP2 ::
  forall b m.
  (CacheRWM m, QErrM m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  UntrackTable b ->
  m EncJSON
unTrackExistingTableOrViewP2 :: UntrackTable b -> m EncJSON
unTrackExistingTableOrViewP2 (UntrackTable SourceName
source TableName b
tableName Bool
cascade) = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  SourceConfig b
sourceConfig <- SourceName -> m (SourceConfig b)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @b SourceName
source
  TableInfo b
sourceInfo <- SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
tableName
  let triggers :: [TriggerName]
triggers = HashMap TriggerName (EventTriggerInfo b) -> [TriggerName]
forall k v. HashMap k v -> [k]
HM.keys (HashMap TriggerName (EventTriggerInfo b) -> [TriggerName])
-> HashMap TriggerName (EventTriggerInfo b) -> [TriggerName]
forall a b. (a -> b) -> a -> b
$ TableInfo b -> HashMap TriggerName (EventTriggerInfo b)
forall (b :: BackendType). TableInfo b -> EventTriggerInfoMap b
_tiEventTriggerInfoMap TableInfo b
sourceInfo
  -- Get relational, query template and function dependants
  let allDeps :: [SchemaObjId]
allDeps =
        SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs
          SchemaCache
sc
          (SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ TableName b -> SourceObjId b
forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
tableName)
      indirectDeps :: [SchemaObjId]
indirectDeps = (SchemaObjId -> Maybe SchemaObjId)
-> [SchemaObjId] -> [SchemaObjId]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe SchemaObjId -> Maybe SchemaObjId
getIndirectDep [SchemaObjId]
allDeps

  -- Report bach with an error if cascade is not set
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
indirectDeps Bool -> Bool -> Bool
|| Bool
cascade) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    [SchemaObjId] -> m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
indirectDeps
  -- Purge all the dependents from state
  MetadataModifier
metadataModifier <- WriterT MetadataModifier m () -> m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT do
    (SchemaObjId -> WriterT MetadataModifier m ())
-> [SchemaObjId] -> WriterT MetadataModifier m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ SchemaObjId -> WriterT MetadataModifier m ()
forall (m :: * -> *).
MonadError QErr m =>
SchemaObjId -> WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies [SchemaObjId]
indirectDeps
    MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MetadataModifier -> WriterT MetadataModifier m ())
-> MetadataModifier -> WriterT MetadataModifier m ()
forall a b. (a -> b) -> a -> b
$ SourceName -> TableName b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> MetadataModifier
dropTableInMetadata @b SourceName
source TableName b
tableName
  -- delete the table and its direct dependencies
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
metadataModifier
  -- drop all the hasura SQL triggers present on the table
  [TriggerName] -> (TriggerName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TriggerName]
triggers ((TriggerName -> m ()) -> m ()) -> (TriggerName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \TriggerName
triggerName -> do
    SourceConfig b -> TriggerName -> TableName b -> m ()
forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadIO m, MonadError QErr m) =>
SourceConfig b -> TriggerName -> TableName b -> m ()
dropTriggerAndArchiveEvents @b SourceConfig b
sourceConfig TriggerName
triggerName TableName b
tableName
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    getIndirectDep :: SchemaObjId -> Maybe SchemaObjId
    getIndirectDep :: SchemaObjId -> Maybe SchemaObjId
getIndirectDep = \case
      sourceObj :: SchemaObjId
sourceObj@(SOSourceObj SourceName
s AnyBackend SourceObjId
exists) ->
        -- If the dependency is to any other source, it automatically is an
        -- indirect dependency, hence the cast is safe here. However, we don't
        -- have these cross source dependencies yet
        AnyBackend SourceObjId -> Maybe (SourceObjId b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @b AnyBackend SourceObjId
exists Maybe (SourceObjId b)
-> (SourceObjId b -> Maybe SchemaObjId) -> Maybe SchemaObjId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          (SOITableObj TableName b
dependentTableName TableObjId b
_) ->
            if Bool -> Bool
not (SourceName
s SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
source Bool -> Bool -> Bool
&& TableName b
tableName TableName b -> TableName b -> Bool
forall a. Eq a => a -> a -> Bool
== TableName b
dependentTableName) then SchemaObjId -> Maybe SchemaObjId
forall a. a -> Maybe a
Just SchemaObjId
sourceObj else Maybe SchemaObjId
forall a. Maybe a
Nothing
          SourceObjId b
_ -> SchemaObjId -> Maybe SchemaObjId
forall a. a -> Maybe a
Just SchemaObjId
sourceObj
      -- A remote schema can have a remote relationship with a table. So when a
      -- table is dropped, the remote relationship in remote schema also needs to
      -- be removed.
      sourceObj :: SchemaObjId
sourceObj@(SORemoteSchemaRemoteRelationship {}) -> SchemaObjId -> Maybe SchemaObjId
forall a. a -> Maybe a
Just SchemaObjId
sourceObj
      SchemaObjId
_ -> Maybe SchemaObjId
forall a. Maybe a
Nothing

runUntrackTableQ ::
  forall b m.
  (CacheRWM m, QErrM m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  UntrackTable b ->
  m EncJSON
runUntrackTableQ :: UntrackTable b -> m EncJSON
runUntrackTableQ UntrackTable b
q = do
  UntrackTable b -> m ()
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, QErrM m, Backend b) =>
UntrackTable b -> m ()
unTrackExistingTableOrViewP1 @b UntrackTable b
q
  UntrackTable b -> m EncJSON
forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, QErrM m, MetadataM m, BackendMetadata b,
 BackendEventTrigger b, MonadIO m) =>
UntrackTable b -> m EncJSON
unTrackExistingTableOrViewP2 @b UntrackTable b
q

-- | Builds an initial table cache. Does not fill in permissions or event triggers, and the returned
-- @FieldInfoMap@s only contain columns, not relationships; those pieces of information are filled
-- in later.
buildTableCache ::
  forall arr m b.
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Inc.ArrowCache m arr,
    MonadIO m,
    MonadBaseControl IO m,
    BackendMetadata b
  ) =>
  ( SourceName,
    SourceConfig b,
    DBTablesMetadata b,
    [TableBuildInput b],
    Inc.Dependency Inc.InvalidationKey,
    NamingCase
  )
    `arr` Map.HashMap (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
buildTableCache :: arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase)
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
buildTableCache = arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase)
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> arr
     (SourceName, SourceConfig b, DBTablesMetadata b,
      [TableBuildInput b], Dependency InvalidationKey, NamingCase)
     (HashMap
        (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (SourceName
source, SourceConfig b
sourceConfig, DBTablesMetadata b
dbTablesMeta, [TableBuildInput b]
tableBuildInputs, Dependency InvalidationKey
reloadMetadataInvalidationKey, NamingCase
tCase) -> do
  HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
rawTableInfos <-
    (|
      forall a.
arr
  (a,
   ((SourceName, TableName b), (NonEmpty (TableBuildInput b), ())))
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> arr
     (a,
      (HashMap (SourceName, TableName b) (NonEmpty (TableBuildInput b)),
       ()))
     (HashMap
        (SourceName, TableName b)
        (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b))))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
        (|
          forall a.
ErrorA
  QErr
  arr
  (a, (NonEmpty (TableBuildInput b), ()))
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> arr
     (a,
      ((SourceName, TableName b), (NonEmpty (TableBuildInput b), ())))
     (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
forall e s a.
ErrorA QErr arr (e, s) a
-> arr (e, ((SourceName, TableName b), s)) (Maybe a)
withTable
            ( \NonEmpty (TableBuildInput b)
tables -> do
                TableBuildInput b
table <- ErrorA QErr arr (NonEmpty (TableBuildInput b)) (TableBuildInput b)
forall t. ErrorA QErr arr (NonEmpty t) t
noDuplicateTables -< NonEmpty (TableBuildInput b)
tables
                let maybeInfo :: Maybe (DBTableMetadata b)
maybeInfo = TableName b -> DBTablesMetadata b -> Maybe (DBTableMetadata b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (TableBuildInput b -> TableName b
forall (b :: BackendType). TableBuildInput b -> TableName b
_tbiName TableBuildInput b
table) DBTablesMetadata b
dbTablesMeta
                ErrorA
  QErr
  arr
  (TableBuildInput b, Maybe (DBTableMetadata b), SourceConfig b,
   Dependency InvalidationKey)
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
buildRawTableInfo -< (TableBuildInput b
table, Maybe (DBTableMetadata b)
maybeInfo, SourceConfig b
sourceConfig, Dependency InvalidationKey
reloadMetadataInvalidationKey)
            )
        |)
      |) (SourceName
-> HashMap (TableName b) (NonEmpty (TableBuildInput b))
-> HashMap (SourceName, TableName b) (NonEmpty (TableBuildInput b))
forall k v.
(Eq k, Hashable k) =>
SourceName -> HashMap k v -> HashMap (SourceName, k) v
withSourceInKey SourceName
source (HashMap (TableName b) (NonEmpty (TableBuildInput b))
 -> HashMap
      (SourceName, TableName b) (NonEmpty (TableBuildInput b)))
-> HashMap (TableName b) (NonEmpty (TableBuildInput b))
-> HashMap (SourceName, TableName b) (NonEmpty (TableBuildInput b))
forall a b. (a -> b) -> a -> b
$ (TableBuildInput b -> TableName b)
-> [TableBuildInput b]
-> HashMap (TableName b) (NonEmpty (TableBuildInput b))
forall k (t :: * -> *) v.
(Eq k, Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k (NonEmpty v)
Map.groupOnNE TableBuildInput b -> TableName b
forall (b :: BackendType). TableBuildInput b -> TableName b
_tbiName [TableBuildInput b]
tableBuildInputs)
  let rawTableCache :: HashMap
  (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
rawTableCache = HashMap
  (SourceName, TableName b)
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall k v.
(Eq k, Hashable k) =>
HashMap (SourceName, k) v -> HashMap k v
removeSourceInKey (HashMap
   (SourceName, TableName b)
   (TableCoreInfoG b (RawColumnInfo b) (Column b))
 -> HashMap
      (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> HashMap
     (SourceName, TableName b)
     (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall a b. (a -> b) -> a -> b
$ HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> HashMap
     (SourceName, TableName b)
     (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
rawTableInfos
      enumTables :: HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables = ((TableCoreInfoG b (RawColumnInfo b) (Column b)
  -> Maybe (PrimaryKey b (Column b), TableConfig b, EnumValues))
 -> HashMap
      (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
 -> HashMap
      (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> (TableCoreInfoG b (RawColumnInfo b) (Column b)
    -> Maybe (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> HashMap
     (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TableCoreInfoG b (RawColumnInfo b) (Column b)
 -> Maybe (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> HashMap
     (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe HashMap
  (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
rawTableCache \TableCoreInfoG b (RawColumnInfo b) (Column b)
rawTableInfo ->
        (,,) (PrimaryKey b (Column b)
 -> TableConfig b
 -> EnumValues
 -> (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> Maybe (PrimaryKey b (Column b))
-> Maybe
     (TableConfig b
      -> EnumValues
      -> (PrimaryKey b (Column b), TableConfig b, EnumValues))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableCoreInfoG b (RawColumnInfo b) (Column b)
-> Maybe (PrimaryKey b (Column b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b (RawColumnInfo b) (Column b)
rawTableInfo Maybe
  (TableConfig b
   -> EnumValues
   -> (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> Maybe (TableConfig b)
-> Maybe
     (EnumValues
      -> (PrimaryKey b (Column b), TableConfig b, EnumValues))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableConfig b -> Maybe (TableConfig b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableCoreInfoG b (RawColumnInfo b) (Column b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig TableCoreInfoG b (RawColumnInfo b) (Column b)
rawTableInfo) Maybe
  (EnumValues
   -> (PrimaryKey b (Column b), TableConfig b, EnumValues))
-> Maybe EnumValues
-> Maybe (PrimaryKey b (Column b), TableConfig b, EnumValues)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableCoreInfoG b (RawColumnInfo b) (Column b) -> Maybe EnumValues
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe EnumValues
_tciEnumValues TableCoreInfoG b (RawColumnInfo b) (Column b)
rawTableInfo
  HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
tableInfos <-
    (|
      forall a.
arr
  (a,
   ((SourceName, TableName b),
    (TableCoreInfoG b (RawColumnInfo b) (Column b), ())))
  (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> arr
     (a,
      (HashMap
         (SourceName, TableName b)
         (TableCoreInfoG b (RawColumnInfo b) (Column b)),
       ()))
     (HashMap
        (SourceName, TableName b)
        (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
        (| forall a.
ErrorA
  QErr
  arr
  (a, (TableCoreInfoG b (RawColumnInfo b) (Column b), ()))
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> arr
     (a,
      ((SourceName, TableName b),
       (TableCoreInfoG b (RawColumnInfo b) (Column b), ())))
     (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
forall e s a.
ErrorA QErr arr (e, s) a
-> arr (e, ((SourceName, TableName b), s)) (Maybe a)
withTable (\TableCoreInfoG b (RawColumnInfo b) (Column b)
table -> ErrorA
  QErr
  arr
  (HashMap
     (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues),
   TableCoreInfoG b (RawColumnInfo b) (Column b), NamingCase)
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
processTableInfo -< (HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables, TableCoreInfoG b (RawColumnInfo b) (Column b)
table, NamingCase
tCase)) |)
      |) (SourceName
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> HashMap
     (SourceName, TableName b)
     (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall k v.
(Eq k, Hashable k) =>
SourceName -> HashMap k v -> HashMap (SourceName, k) v
withSourceInKey SourceName
source HashMap
  (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
rawTableCache)
  arr
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< HashMap
  (SourceName, TableName b)
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall k v.
(Eq k, Hashable k) =>
HashMap (SourceName, k) v -> HashMap k v
removeSourceInKey (HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> HashMap
     (SourceName, TableName b)
     (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap
  (SourceName, TableName b)
  (Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
tableInfos)
  where
    withSourceInKey :: (Eq k, Hashable k) => SourceName -> HashMap k v -> HashMap (SourceName, k) v
    withSourceInKey :: SourceName -> HashMap k v -> HashMap (SourceName, k) v
withSourceInKey SourceName
source = (k -> (SourceName, k)) -> HashMap k v -> HashMap (SourceName, k) v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys (SourceName
source,)

    removeSourceInKey :: (Eq k, Hashable k) => HashMap (SourceName, k) v -> HashMap k v
    removeSourceInKey :: HashMap (SourceName, k) v -> HashMap k v
removeSourceInKey = ((SourceName, k) -> k) -> HashMap (SourceName, k) v -> HashMap k v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys (SourceName, k) -> k
forall a b. (a, b) -> b
snd

    withTable :: ErrorA QErr arr (e, s) a -> arr (e, ((SourceName, TableName b), s)) (Maybe a)
    withTable :: ErrorA QErr arr (e, s) a
-> arr (e, ((SourceName, TableName b), s)) (Maybe a)
withTable ErrorA QErr arr (e, s) a
f =
      ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency ErrorA QErr arr (e, s) a
f
        arr (e, (MetadataObject, s)) (Maybe a)
-> arr (e, ((SourceName, TableName b), s)) (e, (MetadataObject, s))
-> arr (e, ((SourceName, TableName b), s)) (Maybe a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< arr ((SourceName, TableName b), s) (MetadataObject, s)
-> arr (e, ((SourceName, TableName b), s)) (e, (MetadataObject, s))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
          ( arr (SourceName, TableName b) MetadataObject
-> arr ((SourceName, TableName b), s) (MetadataObject, s)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (arr (SourceName, TableName b) MetadataObject
 -> arr ((SourceName, TableName b), s) (MetadataObject, s))
-> arr (SourceName, TableName b) MetadataObject
-> arr ((SourceName, TableName b), s) (MetadataObject, s)
forall a b. (a -> b) -> a -> b
$ ((SourceName, TableName b) -> MetadataObject)
-> arr (SourceName, TableName b) MetadataObject
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(SourceName
source, TableName b
name) ->
              MetadataObjId -> Value -> MetadataObject
MetadataObject
                ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
                    SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
                      TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
name
                )
                (TableName b -> Value
forall a. ToJSON a => a -> Value
toJSON TableName b
name)
          )

    noDuplicateTables :: ErrorA QErr arr (NonEmpty t) t
noDuplicateTables = proc NonEmpty t
tables -> case NonEmpty t
tables of
      t
table :| [] -> ErrorA QErr arr t t
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< t
table
      NonEmpty t
_ -> ErrorA QErr arr QErr t
forall e (arr :: * -> * -> *) a. ArrowError e arr => arr e a
throwA -< Code -> Text -> QErr
err400 Code
AlreadyExists Text
"duplication definition for table"

    -- Step 1: Build the raw table cache from metadata information.
    buildRawTableInfo ::
      ErrorA
        QErr
        arr
        ( TableBuildInput b,
          Maybe (DBTableMetadata b),
          SourceConfig b,
          Inc.Dependency Inc.InvalidationKey
        )
        (TableCoreInfoG b (RawColumnInfo b) (Column b))
    buildRawTableInfo :: ErrorA
  QErr
  arr
  (TableBuildInput b, Maybe (DBTableMetadata b), SourceConfig b,
   Dependency InvalidationKey)
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
buildRawTableInfo = ErrorA
  QErr
  arr
  (TableBuildInput b, Maybe (DBTableMetadata b), SourceConfig b,
   Dependency InvalidationKey)
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> ErrorA
     QErr
     arr
     (TableBuildInput b, Maybe (DBTableMetadata b), SourceConfig b,
      Dependency InvalidationKey)
     (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (TableBuildInput b
tableBuildInput, Maybe (DBTableMetadata b)
maybeInfo, SourceConfig b
sourceConfig, Dependency InvalidationKey
reloadMetadataInvalidationKey) -> do
      let TableBuildInput TableName b
name Bool
isEnum TableConfig b
config Maybe ApolloFederationConfig
apolloFedConfig = TableBuildInput b
tableBuildInput
      DBTableMetadata b
metadataTable <-
        (|
          forall a.
ErrorA QErr arr (a, ()) (DBTableMetadata b)
-> ErrorA
     QErr arr (a, (Maybe (DBTableMetadata b), ())) (DBTableMetadata b)
forall (arr :: * -> * -> *) e s a.
ArrowChoice arr =>
arr (e, s) a -> arr (e, (Maybe a, s)) a
onNothingA
            ( ErrorA QErr arr QErr (DBTableMetadata b)
forall e (arr :: * -> * -> *) a. ArrowError e arr => arr e a
throwA
                -<
                  Code -> Text -> QErr
err400 Code
NotExists (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"no such table/view exists in source: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
name
            )
          |) Maybe (DBTableMetadata b)
maybeInfo

      let [RawColumnInfo b]
columns :: [RawColumnInfo b] = DBTableMetadata b -> [RawColumnInfo b]
forall (b :: BackendType). DBTableMetadata b -> [RawColumnInfo b]
_ptmiColumns DBTableMetadata b
metadataTable
          columnMap :: HashMap FieldName (RawColumnInfo b)
columnMap = (RawColumnInfo b -> FieldName)
-> [RawColumnInfo b] -> HashMap FieldName (RawColumnInfo b)
forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k a
mapFromL (Text -> FieldName
FieldName (Text -> FieldName)
-> (RawColumnInfo b -> Text) -> RawColumnInfo b -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column b -> Text
forall a. ToTxt a => a -> Text
toTxt (Column b -> Text)
-> (RawColumnInfo b -> Column b) -> RawColumnInfo b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawColumnInfo b -> Column b
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName) [RawColumnInfo b]
columns
          primaryKey :: Maybe (PrimaryKey b (Column b))
primaryKey = DBTableMetadata b -> Maybe (PrimaryKey b (Column b))
forall (b :: BackendType).
DBTableMetadata b -> Maybe (PrimaryKey b (Column b))
_ptmiPrimaryKey DBTableMetadata b
metadataTable
          description :: Maybe PGDescription
description = TableName b
-> TableConfig b -> DBTableMetadata b -> Maybe PGDescription
buildDescription TableName b
name TableConfig b
config DBTableMetadata b
metadataTable
      Maybe (PrimaryKey b (RawColumnInfo b))
rawPrimaryKey <- ErrorA
  QErr
  arr
  (Either QErr (Maybe (PrimaryKey b (RawColumnInfo b))))
  (Maybe (PrimaryKey b (RawColumnInfo b)))
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA -< (PrimaryKey b (Column b)
 -> Either QErr (PrimaryKey b (RawColumnInfo b)))
-> Maybe (PrimaryKey b (Column b))
-> Either QErr (Maybe (PrimaryKey b (RawColumnInfo b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (HashMap FieldName (RawColumnInfo b)
-> PrimaryKey b (Column b)
-> Either QErr (PrimaryKey b (RawColumnInfo b))
forall (n :: * -> *) a.
QErrM n =>
HashMap FieldName a
-> PrimaryKey b (Column b) -> n (PrimaryKey b a)
resolvePrimaryKeyColumns HashMap FieldName (RawColumnInfo b)
columnMap) Maybe (PrimaryKey b (Column b))
primaryKey
      Maybe EnumValues
enumValues <-
        if Bool
isEnum
          then do
            -- We want to make sure we reload enum values whenever someone explicitly calls
            -- `reload_metadata`.
            ErrorA QErr arr (Dependency InvalidationKey) InvalidationKey
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Cacheable a) =>
arr (Dependency a) a
Inc.dependOn -< Dependency InvalidationKey
reloadMetadataInvalidationKey
            Either QErr EnumValues
eitherEnums <- ErrorA
  QErr arr (m (Either QErr EnumValues)) (Either QErr EnumValues)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< SourceConfig b
-> TableName b
-> Maybe (PrimaryKey b (RawColumnInfo b))
-> [RawColumnInfo b]
-> m (Either QErr EnumValues)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m) =>
SourceConfig b
-> TableName b
-> Maybe (PrimaryKey b (RawColumnInfo b))
-> [RawColumnInfo b]
-> m (Either QErr EnumValues)
fetchAndValidateEnumValues SourceConfig b
sourceConfig TableName b
name Maybe (PrimaryKey b (RawColumnInfo b))
rawPrimaryKey [RawColumnInfo b]
columns
            ErrorA QErr arr (Either QErr (Maybe EnumValues)) (Maybe EnumValues)
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA -< EnumValues -> Maybe EnumValues
forall a. a -> Maybe a
Just (EnumValues -> Maybe EnumValues)
-> Either QErr EnumValues -> Either QErr (Maybe EnumValues)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either QErr EnumValues
eitherEnums
          else ErrorA QErr arr (Maybe EnumValues) (Maybe EnumValues)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe EnumValues
forall a. Maybe a
Nothing

      ErrorA
  QErr
  arr
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
        -<
          TableCoreInfo :: forall (b :: BackendType) field primaryKeyColumn.
TableName b
-> Maybe PGDescription
-> FieldInfoMap field
-> Maybe (PrimaryKey b primaryKeyColumn)
-> HashSet (UniqueConstraint b)
-> HashSet (ForeignKey b)
-> Maybe ViewInfo
-> Maybe EnumValues
-> TableConfig b
-> ExtraTableMetadata b
-> Maybe ApolloFederationConfig
-> TableCoreInfoG b field primaryKeyColumn
TableCoreInfo
            { _tciName :: TableName b
_tciName = TableName b
name,
              _tciFieldInfoMap :: HashMap FieldName (RawColumnInfo b)
_tciFieldInfoMap = HashMap FieldName (RawColumnInfo b)
columnMap,
              _tciPrimaryKey :: Maybe (PrimaryKey b (Column b))
_tciPrimaryKey = Maybe (PrimaryKey b (Column b))
primaryKey,
              _tciUniqueConstraints :: HashSet (UniqueConstraint b)
_tciUniqueConstraints = DBTableMetadata b -> HashSet (UniqueConstraint b)
forall (b :: BackendType).
DBTableMetadata b -> HashSet (UniqueConstraint b)
_ptmiUniqueConstraints DBTableMetadata b
metadataTable,
              _tciForeignKeys :: HashSet (ForeignKey b)
_tciForeignKeys = (ForeignKeyMetadata b -> ForeignKey b)
-> HashSet (ForeignKeyMetadata b) -> HashSet (ForeignKey b)
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
S.map ForeignKeyMetadata b -> ForeignKey b
forall (b :: BackendType). ForeignKeyMetadata b -> ForeignKey b
unForeignKeyMetadata (HashSet (ForeignKeyMetadata b) -> HashSet (ForeignKey b))
-> HashSet (ForeignKeyMetadata b) -> HashSet (ForeignKey b)
forall a b. (a -> b) -> a -> b
$ DBTableMetadata b -> HashSet (ForeignKeyMetadata b)
forall (b :: BackendType).
DBTableMetadata b -> HashSet (ForeignKeyMetadata b)
_ptmiForeignKeys DBTableMetadata b
metadataTable,
              _tciViewInfo :: Maybe ViewInfo
_tciViewInfo = DBTableMetadata b -> Maybe ViewInfo
forall (b :: BackendType). DBTableMetadata b -> Maybe ViewInfo
_ptmiViewInfo DBTableMetadata b
metadataTable,
              _tciEnumValues :: Maybe EnumValues
_tciEnumValues = Maybe EnumValues
enumValues,
              _tciCustomConfig :: TableConfig b
_tciCustomConfig = TableConfig b
config,
              _tciDescription :: Maybe PGDescription
_tciDescription = Maybe PGDescription
description,
              _tciExtraTableMetadata :: ExtraTableMetadata b
_tciExtraTableMetadata = DBTableMetadata b -> ExtraTableMetadata b
forall (b :: BackendType).
DBTableMetadata b -> ExtraTableMetadata b
_ptmiExtraTableMetadata DBTableMetadata b
metadataTable,
              _tciApolloFederationConfig :: Maybe ApolloFederationConfig
_tciApolloFederationConfig = Maybe ApolloFederationConfig
apolloFedConfig
            }

    -- Step 2: Process the raw table cache to replace Postgres column types with logical column
    -- types.
    processTableInfo ::
      ErrorA
        QErr
        arr
        ( Map.HashMap (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues),
          TableCoreInfoG b (RawColumnInfo b) (Column b),
          NamingCase
        )
        (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
    processTableInfo :: ErrorA
  QErr
  arr
  (HashMap
     (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues),
   TableCoreInfoG b (RawColumnInfo b) (Column b), NamingCase)
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
processTableInfo = proc (HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables, TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo, NamingCase
tCase) ->
      ErrorA
  QErr
  arr
  (Either QErr (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA
        -< do
          let columns :: HashMap FieldName (RawColumnInfo b)
columns = TableCoreInfoG b (RawColumnInfo b) (Column b)
-> HashMap FieldName (RawColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo
              enumReferences :: HashMap (Column b) (NonEmpty (EnumReference b))
enumReferences = HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
-> HashSet (ForeignKey b)
-> HashMap (Column b) (NonEmpty (EnumReference b))
forall (b :: BackendType).
Backend b =>
HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
-> HashSet (ForeignKey b)
-> HashMap (Column b) (NonEmpty (EnumReference b))
resolveEnumReferences HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables (TableCoreInfoG b (RawColumnInfo b) (Column b)
-> HashSet (ForeignKey b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciForeignKeys TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo)
          HashMap FieldName (ColumnInfo b)
columnInfoMap <-
            HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> Either
     QErr (FieldInfoMap (RawColumnInfo b, Name, Maybe Description))
forall (n :: * -> *).
QErrM n =>
HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> n (FieldInfoMap (RawColumnInfo b, Name, Maybe Description))
collectColumnConfiguration HashMap FieldName (RawColumnInfo b)
columns (TableCoreInfoG b (RawColumnInfo b) (Column b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo)
              Either
  QErr (FieldInfoMap (RawColumnInfo b, Name, Maybe Description))
-> (FieldInfoMap (RawColumnInfo b, Name, Maybe Description)
    -> Either QErr (HashMap FieldName (ColumnInfo b)))
-> Either QErr (HashMap FieldName (ColumnInfo b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((RawColumnInfo b, Name, Maybe Description)
 -> Either QErr (ColumnInfo b))
-> FieldInfoMap (RawColumnInfo b, Name, Maybe Description)
-> Either QErr (HashMap FieldName (ColumnInfo b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, Name, Maybe Description)
-> Either QErr (ColumnInfo b)
forall (n :: * -> *).
QErrM n =>
NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, Name, Maybe Description)
-> n (ColumnInfo b)
processColumnInfo NamingCase
tCase HashMap (Column b) (NonEmpty (EnumReference b))
enumReferences (TableCoreInfoG b (RawColumnInfo b) (Column b) -> TableName b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo))
          [ColumnInfo b] -> Either QErr ()
forall (f :: * -> *) (t :: * -> *) (b :: BackendType).
(Foldable t, MonadError QErr f, ToTxt (Column b)) =>
t (ColumnInfo b) -> f ()
assertNoDuplicateFieldNames (HashMap FieldName (ColumnInfo b) -> [ColumnInfo b]
forall k v. HashMap k v -> [v]
Map.elems HashMap FieldName (ColumnInfo b)
columnInfoMap)

          Maybe (PrimaryKey b (ColumnInfo b))
primaryKey <- (PrimaryKey b (Column b)
 -> Either QErr (PrimaryKey b (ColumnInfo b)))
-> Maybe (PrimaryKey b (Column b))
-> Either QErr (Maybe (PrimaryKey b (ColumnInfo b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (HashMap FieldName (ColumnInfo b)
-> PrimaryKey b (Column b)
-> Either QErr (PrimaryKey b (ColumnInfo b))
forall (n :: * -> *) a.
QErrM n =>
HashMap FieldName a
-> PrimaryKey b (Column b) -> n (PrimaryKey b a)
resolvePrimaryKeyColumns HashMap FieldName (ColumnInfo b)
columnInfoMap) (TableCoreInfoG b (RawColumnInfo b) (Column b)
-> Maybe (PrimaryKey b (Column b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo)
          TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> Either QErr (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo
              { _tciFieldInfoMap :: HashMap FieldName (ColumnInfo b)
_tciFieldInfoMap = HashMap FieldName (ColumnInfo b)
columnInfoMap,
                _tciPrimaryKey :: Maybe (PrimaryKey b (ColumnInfo b))
_tciPrimaryKey = Maybe (PrimaryKey b (ColumnInfo b))
primaryKey
              }

    resolvePrimaryKeyColumns ::
      forall n a. (QErrM n) => HashMap FieldName a -> PrimaryKey b (Column b) -> n (PrimaryKey b a)
    resolvePrimaryKeyColumns :: HashMap FieldName a
-> PrimaryKey b (Column b) -> n (PrimaryKey b a)
resolvePrimaryKeyColumns HashMap FieldName a
columnMap = LensLike n (PrimaryKey b (Column b)) (PrimaryKey b a) (Column b) a
-> LensLike
     n (PrimaryKey b (Column b)) (PrimaryKey b a) (Column b) a
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((NESeq (Column b) -> n (NESeq a))
-> PrimaryKey b (Column b) -> n (PrimaryKey b a)
forall (b :: BackendType) a1 a2.
Lens (PrimaryKey b a1) (PrimaryKey b a2) (NESeq a1) (NESeq a2)
pkColumns ((NESeq (Column b) -> n (NESeq a))
 -> PrimaryKey b (Column b) -> n (PrimaryKey b a))
-> ((Column b -> n a) -> NESeq (Column b) -> n (NESeq a))
-> LensLike
     n (PrimaryKey b (Column b)) (PrimaryKey b a) (Column b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column b -> n a) -> NESeq (Column b) -> n (NESeq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) \Column b
columnName ->
      FieldName -> HashMap FieldName a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Text -> FieldName
FieldName (Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
columnName)) HashMap FieldName a
columnMap
        Maybe a -> n a -> n a
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> n a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"column in primary key not in table!"

    collectColumnConfiguration ::
      (QErrM n) =>
      FieldInfoMap (RawColumnInfo b) ->
      TableConfig b ->
      n (FieldInfoMap (RawColumnInfo b, G.Name, Maybe G.Description))
    collectColumnConfiguration :: HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> n (FieldInfoMap (RawColumnInfo b, Name, Maybe Description))
collectColumnConfiguration HashMap FieldName (RawColumnInfo b)
columns TableConfig {Maybe Name
HashMap (Column b) ColumnConfig
Comment
TableCustomRootFields
_tcComment :: forall (b :: BackendType). TableConfig b -> Comment
_tcCustomName :: forall (b :: BackendType). TableConfig b -> Maybe Name
_tcColumnConfig :: forall (b :: BackendType).
TableConfig b -> HashMap (Column b) ColumnConfig
_tcCustomRootFields :: forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcComment :: Comment
_tcCustomName :: Maybe Name
_tcColumnConfig :: HashMap (Column b) ColumnConfig
_tcCustomRootFields :: TableCustomRootFields
..} = do
      let configByFieldName :: HashMap FieldName ColumnConfig
configByFieldName = (Column b -> FieldName)
-> HashMap (Column b) ColumnConfig
-> HashMap FieldName ColumnConfig
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys (Backend b => Column b -> FieldName
forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @b) HashMap (Column b) ColumnConfig
_tcColumnConfig
      (FieldName
 -> These (RawColumnInfo b) ColumnConfig
 -> n (RawColumnInfo b, Name, Maybe Description))
-> HashMap FieldName (These (RawColumnInfo b) ColumnConfig)
-> n (FieldInfoMap (RawColumnInfo b, Name, Maybe Description))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
Map.traverseWithKey
        (\FieldName
fieldName -> FieldName
-> These (RawColumnInfo b) ColumnConfig
-> n (RawColumnInfo b, ColumnConfig)
forall (n :: * -> *).
QErrM n =>
FieldName
-> These (RawColumnInfo b) ColumnConfig
-> n (RawColumnInfo b, ColumnConfig)
pairColumnInfoAndConfig FieldName
fieldName (These (RawColumnInfo b) ColumnConfig
 -> n (RawColumnInfo b, ColumnConfig))
-> ((RawColumnInfo b, ColumnConfig)
    -> n (RawColumnInfo b, Name, Maybe Description))
-> These (RawColumnInfo b) ColumnConfig
-> n (RawColumnInfo b, Name, Maybe Description)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FieldName
-> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, Name, Maybe Description)
forall (n :: * -> *).
QErrM n =>
FieldName
-> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, Name, Maybe Description)
extractColumnConfiguration FieldName
fieldName)
        (HashMap FieldName (RawColumnInfo b)
-> HashMap FieldName ColumnConfig
-> HashMap FieldName (These (RawColumnInfo b) ColumnConfig)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align HashMap FieldName (RawColumnInfo b)
columns HashMap FieldName ColumnConfig
configByFieldName)

    pairColumnInfoAndConfig ::
      QErrM n =>
      FieldName ->
      These (RawColumnInfo b) ColumnConfig ->
      n (RawColumnInfo b, ColumnConfig)
    pairColumnInfoAndConfig :: FieldName
-> These (RawColumnInfo b) ColumnConfig
-> n (RawColumnInfo b, ColumnConfig)
pairColumnInfoAndConfig FieldName
fieldName = \case
      This RawColumnInfo b
column -> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, ColumnConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawColumnInfo b
column, ColumnConfig
forall a. Monoid a => a
mempty)
      These RawColumnInfo b
column ColumnConfig
config -> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, ColumnConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawColumnInfo b
column, ColumnConfig
config)
      That ColumnConfig
_ ->
        Code -> Text -> n (RawColumnInfo b, ColumnConfig)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> n (RawColumnInfo b, ColumnConfig))
-> Text -> n (RawColumnInfo b, ColumnConfig)
forall a b. (a -> b) -> a -> b
$
          Text
"configuration was given for the column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName
fieldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
", but no such column exists"

    extractColumnConfiguration ::
      QErrM n =>
      FieldName ->
      (RawColumnInfo b, ColumnConfig) ->
      n (RawColumnInfo b, G.Name, Maybe G.Description)
    extractColumnConfiguration :: FieldName
-> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, Name, Maybe Description)
extractColumnConfiguration FieldName
fieldName (RawColumnInfo b
columnInfo, ColumnConfig {Maybe Name
Comment
_ccfgComment :: ColumnConfig -> Comment
_ccfgComment :: Comment
_ccfgCustomName :: Maybe Name
_ccfgCustomName :: ColumnConfig -> Maybe Name
..}) = do
      Name
name <- Maybe Name
_ccfgCustomName Maybe Name -> n Name -> n Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> n Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (FieldName -> Text
getFieldNameTxt FieldName
fieldName)
      (RawColumnInfo b, Name, Maybe Description)
-> n (RawColumnInfo b, Name, Maybe Description)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawColumnInfo b
columnInfo, Name
name, Maybe Description
description)
      where
        description :: Maybe G.Description
        description :: Maybe Description
description = case Comment
_ccfgComment of
          Comment
Automatic -> RawColumnInfo b -> Maybe Description
forall (b :: BackendType). RawColumnInfo b -> Maybe Description
rciDescription RawColumnInfo b
columnInfo
          (Explicit Maybe NonEmptyText
explicitDesc) -> Text -> Description
G.Description (Text -> Description)
-> (NonEmptyText -> Text) -> NonEmptyText -> Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> Description)
-> Maybe NonEmptyText -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NonEmptyText
explicitDesc

    processColumnInfo ::
      (QErrM n) =>
      NamingCase ->
      Map.HashMap (Column b) (NonEmpty (EnumReference b)) ->
      TableName b ->
      (RawColumnInfo b, G.Name, Maybe G.Description) ->
      n (ColumnInfo b)
    processColumnInfo :: NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, Name, Maybe Description)
-> n (ColumnInfo b)
processColumnInfo NamingCase
tCase HashMap (Column b) (NonEmpty (EnumReference b))
tableEnumReferences TableName b
tableName (RawColumnInfo b
rawInfo, Name
name, Maybe Description
description) = do
      ColumnType b
resolvedType <- n (ColumnType b)
resolveColumnType
      ColumnInfo b -> n (ColumnInfo b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ColumnInfo :: forall (b :: BackendType).
Column b
-> Name
-> Int
-> ColumnType b
-> Bool
-> Maybe Description
-> ColumnMutability
-> ColumnInfo b
ColumnInfo
          { ciColumn :: Column b
ciColumn = Column b
pgCol,
            ciName :: Name
ciName = (NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase Name
name),
            ciPosition :: Int
ciPosition = RawColumnInfo b -> Int
forall (b :: BackendType). RawColumnInfo b -> Int
rciPosition RawColumnInfo b
rawInfo,
            ciType :: ColumnType b
ciType = ColumnType b
resolvedType,
            ciIsNullable :: Bool
ciIsNullable = RawColumnInfo b -> Bool
forall (b :: BackendType). RawColumnInfo b -> Bool
rciIsNullable RawColumnInfo b
rawInfo,
            ciDescription :: Maybe Description
ciDescription = Maybe Description
description,
            ciMutability :: ColumnMutability
ciMutability = RawColumnInfo b -> ColumnMutability
forall (b :: BackendType). RawColumnInfo b -> ColumnMutability
rciMutability RawColumnInfo b
rawInfo
          }
      where
        pgCol :: Column b
pgCol = RawColumnInfo b -> Column b
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName RawColumnInfo b
rawInfo
        resolveColumnType :: n (ColumnType b)
resolveColumnType =
          case Column b
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> Maybe (NonEmpty (EnumReference b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Column b
pgCol HashMap (Column b) (NonEmpty (EnumReference b))
tableEnumReferences of
            -- no references? not an enum
            Maybe (NonEmpty (EnumReference b))
Nothing -> ColumnType b -> n (ColumnType b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnType b -> n (ColumnType b))
-> ColumnType b -> n (ColumnType b)
forall a b. (a -> b) -> a -> b
$ ScalarType b -> ColumnType b
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar (RawColumnInfo b -> ScalarType b
forall (b :: BackendType). RawColumnInfo b -> ScalarType b
rciType RawColumnInfo b
rawInfo)
            -- one reference? is an enum
            Just (EnumReference b
enumReference :| []) -> ColumnType b -> n (ColumnType b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnType b -> n (ColumnType b))
-> ColumnType b -> n (ColumnType b)
forall a b. (a -> b) -> a -> b
$ EnumReference b -> ColumnType b
forall (b :: BackendType). EnumReference b -> ColumnType b
ColumnEnumReference EnumReference b
enumReference
            -- multiple referenced enums? the schema is strange, so let’s reject it
            Just NonEmpty (EnumReference b)
enumReferences ->
              Code -> Text -> n (ColumnType b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation (Text -> n (ColumnType b)) -> Text -> n (ColumnType b)
forall a b. (a -> b) -> a -> b
$
                Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RawColumnInfo b -> Column b
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName RawColumnInfo b
rawInfo Column b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName
                  TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" references multiple enum tables ("
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ((EnumReference b -> Text) -> [EnumReference b] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TableName b -> Text
forall a. ToTxt a => a -> Text
dquote (TableName b -> Text)
-> (EnumReference b -> TableName b) -> EnumReference b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumReference b -> TableName b
forall (b :: BackendType). EnumReference b -> TableName b
erTable) ([EnumReference b] -> [Text]) -> [EnumReference b] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty (EnumReference b) -> [EnumReference b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (EnumReference b)
enumReferences)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

    assertNoDuplicateFieldNames :: t (ColumnInfo b) -> f ()
assertNoDuplicateFieldNames t (ColumnInfo b)
columns =
      f (HashMap Name ()) -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f (HashMap Name ()) -> f ()) -> f (HashMap Name ()) -> f ()
forall a b. (a -> b) -> a -> b
$ ((Name -> [ColumnInfo b] -> f ())
 -> HashMap Name [ColumnInfo b] -> f (HashMap Name ()))
-> HashMap Name [ColumnInfo b]
-> (Name -> [ColumnInfo b] -> f ())
-> f (HashMap Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> [ColumnInfo b] -> f ())
-> HashMap Name [ColumnInfo b] -> f (HashMap Name ())
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
Map.traverseWithKey ((ColumnInfo b -> Name)
-> t (ColumnInfo b) -> HashMap Name [ColumnInfo b]
forall k (t :: * -> *) v.
(Eq k, Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
Map.groupOn ColumnInfo b -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName t (ColumnInfo b)
columns) \Name
name [ColumnInfo b]
columnsWithName ->
        case [ColumnInfo b]
columnsWithName of
          ColumnInfo b
one : ColumnInfo b
two : [ColumnInfo b]
more ->
            Code -> Text -> f ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists (Text -> f ()) -> Text -> f ()
forall a b. (a -> b) -> a -> b
$
              Text
"the definitions of columns "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> NonEmpty Text -> Text
englishList Text
"and" (Column b -> Text
forall a. ToTxt a => a -> Text
dquote (Column b -> Text)
-> (ColumnInfo b -> Column b) -> ColumnInfo b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn (ColumnInfo b -> Text) -> NonEmpty (ColumnInfo b) -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ColumnInfo b
one ColumnInfo b -> [ColumnInfo b] -> NonEmpty (ColumnInfo b)
forall a. a -> [a] -> NonEmpty a
:| ColumnInfo b
two ColumnInfo b -> [ColumnInfo b] -> [ColumnInfo b]
forall a. a -> [a] -> [a]
: [ColumnInfo b]
more))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are in conflict: they are mapped to the same field name, " Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
name
          [ColumnInfo b]
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    buildDescription :: TableName b -> TableConfig b -> DBTableMetadata b -> Maybe PGDescription
    buildDescription :: TableName b
-> TableConfig b -> DBTableMetadata b -> Maybe PGDescription
buildDescription TableName b
tableName TableConfig b
tableConfig DBTableMetadata b
tableMetadata =
      case TableConfig b -> Comment
forall (b :: BackendType). TableConfig b -> Comment
_tcComment TableConfig b
tableConfig of
        Comment
Automatic -> DBTableMetadata b -> Maybe PGDescription
forall (b :: BackendType). DBTableMetadata b -> Maybe PGDescription
_ptmiDescription DBTableMetadata b
tableMetadata Maybe PGDescription -> Maybe PGDescription -> Maybe PGDescription
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PGDescription -> Maybe PGDescription
forall a. a -> Maybe a
Just PGDescription
autogeneratedDescription
        Explicit Maybe NonEmptyText
description -> Text -> PGDescription
PGDescription (Text -> PGDescription)
-> (NonEmptyText -> Text) -> NonEmptyText -> PGDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> PGDescription)
-> Maybe NonEmptyText -> Maybe PGDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NonEmptyText
description
      where
        autogeneratedDescription :: PGDescription
autogeneratedDescription =
          Text -> PGDescription
PGDescription (Text -> PGDescription) -> Text -> PGDescription
forall a b. (a -> b) -> a -> b
$ Text
"columns and relationships of " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName

data SetApolloFederationConfig b = SetApolloFederationConfig
  { SetApolloFederationConfig b -> SourceName
_safcSource :: SourceName,
    SetApolloFederationConfig b -> TableName b
_safcTable :: TableName b,
    -- | Apollo Federation config for the table, setting `Nothing` would disable
    --   Apollo Federation support on the table.
    SetApolloFederationConfig b -> Maybe ApolloFederationConfig
_safcApolloFederationConfig :: Maybe ApolloFederationConfig
  }

instance (Backend b) => FromJSON (SetApolloFederationConfig b) where
  parseJSON :: Value -> Parser (SetApolloFederationConfig b)
parseJSON = String
-> (Object -> Parser (SetApolloFederationConfig b))
-> Value
-> Parser (SetApolloFederationConfig b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetApolloFederationConfig" ((Object -> Parser (SetApolloFederationConfig b))
 -> Value -> Parser (SetApolloFederationConfig b))
-> (Object -> Parser (SetApolloFederationConfig b))
-> Value
-> Parser (SetApolloFederationConfig b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b
-> Maybe ApolloFederationConfig
-> SetApolloFederationConfig b
forall (b :: BackendType).
SourceName
-> TableName b
-> Maybe ApolloFederationConfig
-> SetApolloFederationConfig b
SetApolloFederationConfig
      (SourceName
 -> TableName b
 -> Maybe ApolloFederationConfig
 -> SetApolloFederationConfig b)
-> Parser SourceName
-> Parser
     (TableName b
      -> Maybe ApolloFederationConfig -> SetApolloFederationConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (TableName b
   -> Maybe ApolloFederationConfig -> SetApolloFederationConfig b)
-> Parser (TableName b)
-> Parser
     (Maybe ApolloFederationConfig -> SetApolloFederationConfig b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (Maybe ApolloFederationConfig -> SetApolloFederationConfig b)
-> Parser (Maybe ApolloFederationConfig)
-> Parser (SetApolloFederationConfig b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ApolloFederationConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"apollo_federation_config"

runSetApolloFederationConfig ::
  forall b m.
  (QErrM m, CacheRWM m, MetadataM m, Backend b, BackendMetadata b) =>
  SetApolloFederationConfig b ->
  m EncJSON
runSetApolloFederationConfig :: SetApolloFederationConfig b -> m EncJSON
runSetApolloFederationConfig (SetApolloFederationConfig SourceName
source TableName b
table Maybe ApolloFederationConfig
apolloFedConfig) = do
  m (TableInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo b) -> m ()) -> m (TableInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
table
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    (SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
table)
    -- NOTE (paritosh): This API behaves like a PUT API now. In future, when
    -- the `ApolloFederationConfig` is complex, we should probably reconsider
    -- this approach of replacing the configuration everytime the API is called
    -- and maybe throw some error if the configuration is already there.
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table ASetter' Metadata (TableMetadata b)
-> ((Maybe ApolloFederationConfig
     -> Identity (Maybe ApolloFederationConfig))
    -> TableMetadata b -> Identity (TableMetadata b))
-> (Maybe ApolloFederationConfig
    -> Identity (Maybe ApolloFederationConfig))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ApolloFederationConfig
 -> Identity (Maybe ApolloFederationConfig))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Maybe ApolloFederationConfig)
tmApolloFederationConfig ((Maybe ApolloFederationConfig
  -> Identity (Maybe ApolloFederationConfig))
 -> Metadata -> Identity Metadata)
-> Maybe ApolloFederationConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ApolloFederationConfig
apolloFedConfig
  EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg