{-# LANGUAGE Arrows #-}
{-# LANGUAGE UndecidableInstances #-}

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

import Control.Arrow.Extended
import Control.Arrow.Interpret
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.Extended qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as S
import Data.Text.Casing (GQLNameIdentifier, fromCustomName)
import Data.Text.Extended
import Data.These (These (..))
import Data.Vector (Vector)
import Hasura.Backends.Postgres.SQL.Types (PGDescription (..), QualifiedTable)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Eventing.Backend (BackendEventTrigger, dropTriggerAndArchiveEvents)
import Hasura.GraphQL.Context
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Schema.Common (textToGQLIdentifier)
import Hasura.Incremental qualified as Inc
import Hasura.LogicalModel.Metadata
import Hasura.LogicalModel.Types
import Hasura.Prelude
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Enum (resolveEnumReferences)
import Hasura.RQL.DDL.Warnings
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.EventTrigger (TriggerName)
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.NamingCase
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 (applyFieldNameCaseIdentifier)
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Utils
import Hasura.Table.Cache
import Hasura.Table.Metadata (mkTableMeta, tmApolloFederationConfig, tmConfiguration, tmIsEnum, tmLogicalModel)
import Language.GraphQL.Draft.Syntax qualified as G

data TrackTable b = TrackTable
  { forall (b :: BackendType). TrackTable b -> SourceName
tSource :: SourceName,
    forall (b :: BackendType). TrackTable b -> TableName b
tName :: TableName b,
    forall (b :: BackendType). TrackTable b -> Bool
tIsEnum :: Bool,
    forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tApolloFedConfig :: Maybe ApolloFederationConfig,
    forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tLogicalModel :: Maybe LogicalModelName
  }

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 a. Parser a -> Parser a -> Parser a
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
-> Maybe LogicalModelName
-> TrackTable b
forall (b :: BackendType).
SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> Maybe LogicalModelName
-> TrackTable b
TrackTable
          (SourceName
 -> TableName b
 -> Bool
 -> Maybe ApolloFederationConfig
 -> Maybe LogicalModelName
 -> TrackTable b)
-> Parser SourceName
-> Parser
     (TableName b
      -> Bool
      -> Maybe ApolloFederationConfig
      -> Maybe LogicalModelName
      -> 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
   -> Maybe LogicalModelName
   -> TrackTable b)
-> Parser (TableName b)
-> Parser
     (Bool
      -> Maybe ApolloFederationConfig
      -> Maybe LogicalModelName
      -> TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser 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
   -> Maybe LogicalModelName
   -> TrackTable b)
-> Parser Bool
-> Parser
     (Maybe ApolloFederationConfig
      -> Maybe LogicalModelName -> TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser 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
   -> Maybe LogicalModelName -> TrackTable b)
-> Parser (Maybe ApolloFederationConfig)
-> Parser (Maybe LogicalModelName -> TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser 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"
          Parser (Maybe LogicalModelName -> TrackTable b)
-> Parser (Maybe LogicalModelName) -> Parser (TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
          Object -> Key -> Parser (Maybe LogicalModelName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logical_model"
      withoutOptions :: Parser (TrackTable b)
withoutOptions = SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> Maybe LogicalModelName
-> TrackTable b
forall (b :: BackendType).
SourceName
-> TableName b
-> Bool
-> Maybe ApolloFederationConfig
-> Maybe LogicalModelName
-> TrackTable b
TrackTable SourceName
defaultSource (TableName b
 -> Bool
 -> Maybe ApolloFederationConfig
 -> Maybe LogicalModelName
 -> TrackTable b)
-> Parser (TableName b)
-> Parser
     (Bool
      -> Maybe ApolloFederationConfig
      -> Maybe LogicalModelName
      -> 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
   -> Maybe LogicalModelName
   -> TrackTable b)
-> Parser Bool
-> Parser
     (Maybe ApolloFederationConfig
      -> Maybe LogicalModelName -> TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False Parser
  (Maybe ApolloFederationConfig
   -> Maybe LogicalModelName -> TrackTable b)
-> Parser (Maybe ApolloFederationConfig)
-> Parser (Maybe LogicalModelName -> TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ApolloFederationConfig
-> Parser (Maybe ApolloFederationConfig)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ApolloFederationConfig
forall a. Maybe a
Nothing Parser (Maybe LogicalModelName -> TrackTable b)
-> Parser (Maybe LogicalModelName) -> Parser (TrackTable b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe LogicalModelName -> Parser (Maybe LogicalModelName)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LogicalModelName
forall a. Maybe a
Nothing

data SetTableIsEnum b = SetTableIsEnum
  { forall (b :: BackendType). SetTableIsEnum b -> SourceName
stieSource :: SourceName,
    forall (b :: BackendType). SetTableIsEnum b -> TableName b
stieTable :: TableName b,
    forall (b :: BackendType). SetTableIsEnum b -> Bool
stieIsEnum :: Bool
  }

deriving instance (Eq (TableName b)) => Eq (SetTableIsEnum b)

deriving instance (Show (TableName b)) => Show (SetTableIsEnum b)

instance (Backend b) => FromJSON (SetTableIsEnum b) where
  parseJSON :: Value -> Parser (SetTableIsEnum b)
parseJSON = String
-> (Object -> Parser (SetTableIsEnum b))
-> Value
-> Parser (SetTableIsEnum b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetTableIsEnum" ((Object -> Parser (SetTableIsEnum b))
 -> Value -> Parser (SetTableIsEnum b))
-> (Object -> Parser (SetTableIsEnum b))
-> Value
-> Parser (SetTableIsEnum b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> Bool -> SetTableIsEnum b
forall (b :: BackendType).
SourceName -> TableName b -> Bool -> SetTableIsEnum b
SetTableIsEnum
      (SourceName -> TableName b -> Bool -> SetTableIsEnum b)
-> Parser SourceName
-> Parser (TableName b -> Bool -> SetTableIsEnum 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 -> SetTableIsEnum b)
-> Parser (TableName b) -> Parser (Bool -> SetTableIsEnum b)
forall a b. Parser (a -> b) -> Parser a -> Parser 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 -> SetTableIsEnum b)
-> Parser Bool -> Parser (SetTableIsEnum b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
  { forall (b :: BackendType). UntrackTable b -> SourceName
utSource :: SourceName,
    forall (b :: BackendType). UntrackTable b -> TableName b
utTable :: TableName b,
    forall (b :: BackendType). 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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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 :: forall (b :: BackendType).
Backend b =>
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
HashMap.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.
trackExistingTableOrViewPhase1 ::
  forall b m.
  (QErrM m, CacheRWM m, Backend b, MetadataM m) =>
  SourceName ->
  TableName b ->
  m ()
trackExistingTableOrViewPhase1 :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewPhase1 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 (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 = 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
HashMap.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
$ 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"

queryForExistingFieldNames :: SchemaCache -> Vector Text
queryForExistingFieldNames :: SchemaCache -> Vector Text
queryForExistingFieldNames SchemaCache
schemaCache = do
  let GQLContext ParserFn (RootFieldMap (QueryRootField UnpreparedValue))
queryParser Maybe (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
_ Maybe (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
_ = SchemaCache -> GQLContext
scUnauthenticatedGQLContext SchemaCache
schemaCache
      -- {
      --   __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
_ -> Vector Text
forall a. Monoid a => a
mempty
    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
InsOrdHashMap.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 a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
                  Value
_ -> Maybe Text
forall a. Maybe a
Nothing
          Vector Text -> Maybe (Vector Text) -> Vector Text
forall a. a -> Maybe a -> a
fromMaybe Vector Text
forall a. Monoid a => a
mempty (Maybe (Vector Text) -> Vector Text)
-> Maybe (Vector Text) -> Vector Text
forall a b. (a -> b) -> a -> b
$ Maybe (Vector Text)
names
        Maybe (QueryRootField UnpreparedValue)
_ -> Vector Text
forall a. Monoid a => a
mempty

-- | 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 :: forall (m :: * -> *).
MonadError QErr m =>
SchemaCache -> Text -> m ()
checkConflictingNode SchemaCache
sc Text
tnGQL = do
  let fieldNames :: Vector Text
fieldNames = SchemaCache -> Vector Text
queryForExistingFieldNames SchemaCache
sc
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
tnGQL Text -> Vector Text -> Bool
forall a. Eq a => a -> Vector a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Text
fieldNames)
    (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"

findConflictingNodes ::
  SchemaCache ->
  (a -> Text) ->
  [a] ->
  [(a, QErr)]
findConflictingNodes :: forall a. SchemaCache -> (a -> Text) -> [a] -> [(a, QErr)]
findConflictingNodes SchemaCache
sc a -> Text
extractName [a]
items = do
  let fieldNames :: Vector Text
fieldNames = SchemaCache -> Vector Text
queryForExistingFieldNames SchemaCache
sc
  ((a -> [(a, QErr)]) -> [a] -> [(a, QErr)])
-> [a] -> (a -> [(a, QErr)]) -> [(a, QErr)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> [(a, QErr)]) -> [a] -> [(a, QErr)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [a]
items ((a -> [(a, QErr)]) -> [(a, QErr)])
-> (a -> [(a, QErr)]) -> [(a, QErr)]
forall a b. (a -> b) -> a -> b
$ \a
item ->
    let name :: Text
name = a -> Text
extractName a
item
        err :: QErr
err =
          Code -> Text -> QErr
err400 Code
RemoteSchemaConflicts
            (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"node "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists in current graphql schema"
     in [(a
item, QErr
err) | Text
name Text -> Vector Text -> Bool
forall a. Eq a => a -> Vector a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Text
fieldNames]

trackExistingTableOrViewPhase2 ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  TrackTableV2 b ->
  m EncJSON
trackExistingTableOrViewPhase2 :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTableV2 b -> m EncJSON
trackExistingTableOrViewPhase2 trackTable :: TrackTableV2 b
trackTable@TrackTableV2 {ttv2Table :: forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table = TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..}} = 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
$ forall (b :: BackendType). Backend b => TableName b -> Text
snakeCaseTableName @b TableName b
tName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor
    ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
tSource
        (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
$ forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
tName
    )
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ TrackTableV2 b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataModifier
mkTrackTableMetadataModifier TrackTableV2 b
trackTable
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

mkTrackTableMetadataModifier :: (Backend b) => TrackTableV2 b -> MetadataModifier
mkTrackTableMetadataModifier :: forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataModifier
mkTrackTableMetadataModifier (TrackTableV2 (TrackTable SourceName
source TableName b
tableName Bool
isEnum Maybe ApolloFederationConfig
apolloFedConfig Maybe LogicalModelName
logicalModel) TableConfig b
config) =
  let metadata :: TableMetadata b
metadata =
        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
          TableMetadata b
-> (TableMetadata b -> TableMetadata b) -> TableMetadata b
forall a b. a -> (a -> b) -> b
& (Maybe ApolloFederationConfig
 -> Identity (Maybe ApolloFederationConfig))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe ApolloFederationConfig -> f (Maybe ApolloFederationConfig))
-> TableMetadata b -> f (TableMetadata b)
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 -> (a -> b) -> b
& (Maybe LogicalModelName -> Identity (Maybe LogicalModelName))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Maybe LogicalModelName -> f (Maybe LogicalModelName))
-> TableMetadata b -> f (TableMetadata b)
tmLogicalModel ((Maybe LogicalModelName -> Identity (Maybe LogicalModelName))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe LogicalModelName -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe LogicalModelName
logicalModel
   in (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)
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) (f :: * -> *).
Functor f =>
(Tables b -> f (Tables b))
-> SourceMetadata b -> f (SourceMetadata 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
InsOrdHashMap.insert TableName b
tableName TableMetadata b
metadata

runTrackTableQ ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  TrackTable b ->
  m EncJSON
runTrackTableQ :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTable b -> m EncJSON
runTrackTableQ trackTable :: TrackTable b
trackTable@TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..} = do
  forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewPhase1 @b SourceName
tSource TableName b
tName
  forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTableV2 b -> m EncJSON
trackExistingTableOrViewPhase2 @b (TrackTable b -> TableConfig b -> TrackTableV2 b
forall (b :: BackendType).
TrackTable b -> TableConfig b -> TrackTableV2 b
TrackTableV2 TrackTable b
trackTable TableConfig b
forall (b :: BackendType). TableConfig b
emptyTableConfig)

data TrackTableV2 b = TrackTableV2
  { forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table :: TrackTable b,
    forall (b :: BackendType). 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
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> TrackTableV2 b -> ShowS
showsPrec :: Int -> TrackTableV2 b -> ShowS
$cshow :: forall (b :: BackendType). Backend b => TrackTableV2 b -> String
show :: TrackTableV2 b -> String
$cshowList :: forall (b :: BackendType). Backend b => [TrackTableV2 b] -> ShowS
showList :: [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
$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
/= :: 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 a. a -> Parser a
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 :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTableV2 b -> m EncJSON
runTrackTableV2Q trackTable :: TrackTableV2 b
trackTable@TrackTableV2 {ttv2Table :: forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table = TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..}} = do
  forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewPhase1 @b SourceName
tSource TableName b
tName
  forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTableV2 b -> m EncJSON
trackExistingTableOrViewPhase2 @b TrackTableV2 b
trackTable

data TrackTables b = TrackTables
  { forall (b :: BackendType). TrackTables b -> [TrackTableV2 b]
_ttv2Tables :: [TrackTableV2 b],
    forall (b :: BackendType). TrackTables b -> AllowWarnings
_ttv2AllowWarnings :: AllowWarnings
  }

instance (Backend b) => FromJSON (TrackTables b) where
  parseJSON :: Value -> Parser (TrackTables b)
parseJSON = String
-> (Object -> Parser (TrackTables b))
-> Value
-> Parser (TrackTables b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TrackTables" ((Object -> Parser (TrackTables b))
 -> Value -> Parser (TrackTables b))
-> (Object -> Parser (TrackTables b))
-> Value
-> Parser (TrackTables b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [TrackTableV2 b] -> AllowWarnings -> TrackTables b
forall (b :: BackendType).
[TrackTableV2 b] -> AllowWarnings -> TrackTables b
TrackTables
      ([TrackTableV2 b] -> AllowWarnings -> TrackTables b)
-> Parser [TrackTableV2 b]
-> Parser (AllowWarnings -> TrackTables b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser [TrackTableV2 b]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
      Parser (AllowWarnings -> TrackTables b)
-> Parser AllowWarnings -> Parser (TrackTables b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe AllowWarnings)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_warnings"
      Parser (Maybe AllowWarnings)
-> AllowWarnings -> Parser AllowWarnings
forall a. Parser (Maybe a) -> a -> Parser a
.!= AllowWarnings
AllowWarnings

runTrackTablesQ ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  TrackTables b ->
  m EncJSON
runTrackTablesQ :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
TrackTables b -> m EncJSON
runTrackTablesQ TrackTables {[TrackTableV2 b]
AllowWarnings
_ttv2Tables :: forall (b :: BackendType). TrackTables b -> [TrackTableV2 b]
_ttv2AllowWarnings :: forall (b :: BackendType). TrackTables b -> AllowWarnings
_ttv2Tables :: [TrackTableV2 b]
_ttv2AllowWarnings :: AllowWarnings
..} = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(SourceName, TableName b)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SourceName, TableName b)]
duplicatedTables)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ let tables :: Text
tables = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\(SourceName
source, TableName b
tableName) -> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tableName) ((SourceName, TableName b) -> Text)
-> [(SourceName, TableName b)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceName, TableName b)]
duplicatedTables
       in Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"tables" (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
BadRequest (Text
"The following tables occur more than once in the request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tables)

  ([TrackTableV2 b]
successfulTables, MetadataWarnings
metadataWarnings) <- StateT MetadataWarnings m [TrackTableV2 b]
-> m ([TrackTableV2 b], MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m [TrackTableV2 b]
 -> m ([TrackTableV2 b], MetadataWarnings))
-> StateT MetadataWarnings m [TrackTableV2 b]
-> m ([TrackTableV2 b], MetadataWarnings)
forall a b. (a -> b) -> a -> b
$ do
    [TrackTableV2 b]
phase1SuccessfulTables <- ([[TrackTableV2 b]] -> [TrackTableV2 b])
-> StateT MetadataWarnings m [[TrackTableV2 b]]
-> StateT MetadataWarnings m [TrackTableV2 b]
forall a b.
(a -> b)
-> StateT MetadataWarnings m a -> StateT MetadataWarnings m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[TrackTableV2 b]] -> [TrackTableV2 b]
forall a. Monoid a => [a] -> a
mconcat (StateT MetadataWarnings m [[TrackTableV2 b]]
 -> StateT MetadataWarnings m [TrackTableV2 b])
-> ((TrackTableV2 b -> StateT MetadataWarnings m [TrackTableV2 b])
    -> StateT MetadataWarnings m [[TrackTableV2 b]])
-> (TrackTableV2 b -> StateT MetadataWarnings m [TrackTableV2 b])
-> StateT MetadataWarnings m [TrackTableV2 b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrackTableV2 b]
-> (TrackTableV2 b -> StateT MetadataWarnings m [TrackTableV2 b])
-> StateT MetadataWarnings m [[TrackTableV2 b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [TrackTableV2 b]
_ttv2Tables ((TrackTableV2 b -> StateT MetadataWarnings m [TrackTableV2 b])
 -> StateT MetadataWarnings m [TrackTableV2 b])
-> (TrackTableV2 b -> StateT MetadataWarnings m [TrackTableV2 b])
-> StateT MetadataWarnings m [TrackTableV2 b]
forall a b. (a -> b) -> a -> b
$ \trackTable :: TrackTableV2 b
trackTable@TrackTableV2 {ttv2Table :: forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table = TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..}} -> do
      (forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, Backend b, MetadataM m) =>
SourceName -> TableName b -> m ()
trackExistingTableOrViewPhase1 @b SourceName
tSource TableName b
tName StateT MetadataWarnings m ()
-> [TrackTableV2 b] -> StateT MetadataWarnings m [TrackTableV2 b]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [TrackTableV2 b
trackTable])
        StateT MetadataWarnings m [TrackTableV2 b]
-> (QErr -> StateT MetadataWarnings m [TrackTableV2 b])
-> StateT MetadataWarnings m [TrackTableV2 b]
forall a.
StateT MetadataWarnings m a
-> (QErr -> StateT MetadataWarnings m a)
-> StateT MetadataWarnings m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \QErr
qErr -> do
          let tableObjId :: MetadataObjId
tableObjId = TrackTableV2 b -> MetadataObjId
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataObjId
mkTrackTableV2ObjectId TrackTableV2 b
trackTable
          let message :: Text
message = QErr -> Text
qeError QErr
qErr
          MetadataWarning -> StateT MetadataWarnings m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> StateT MetadataWarnings m ())
-> MetadataWarning -> StateT MetadataWarnings m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCTrackTableFailed MetadataObjId
tableObjId Text
message
          [TrackTableV2 b] -> StateT MetadataWarnings m [TrackTableV2 b]
forall a. a -> StateT MetadataWarnings m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    [TrackTableV2 b] -> StateT MetadataWarnings m [TrackTableV2 b]
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, MonadWarnings m, CacheRWM m, MetadataM m,
 BackendMetadata b) =>
[TrackTableV2 b] -> m [TrackTableV2 b]
trackExistingTablesOrViewsPhase2 [TrackTableV2 b]
phase1SuccessfulTables

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TrackTableV2 b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TrackTableV2 b]
successfulTables)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Value -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail Code
InvalidConfiguration Text
"all tables failed to track" (MetadataWarnings -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataWarnings
metadataWarnings)

  case AllowWarnings
_ttv2AllowWarnings of
    AllowWarnings
AllowWarnings -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AllowWarnings
DisallowWarnings ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MetadataWarnings -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MetadataWarnings
metadataWarnings)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Value -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (Text -> Code
CustomCode Text
"metadata-warnings") Text
"failed due to metadata warnings" (MetadataWarnings -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataWarnings
metadataWarnings)

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings MetadataWarnings
metadataWarnings
  where
    duplicatedTables :: [(SourceName, TableName b)]
    duplicatedTables :: [(SourceName, TableName b)]
duplicatedTables =
      [TrackTableV2 b]
_ttv2Tables
        [TrackTableV2 b]
-> ([TrackTableV2 b] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& (TrackTableV2 b -> (SourceName, TableName b))
-> [TrackTableV2 b] -> [(SourceName, TableName b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TrackTableV2 {ttv2Table :: forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table = TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..}} -> (SourceName
tSource, TableName b
tName))
        [(SourceName, TableName b)]
-> ([(SourceName, TableName b)] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& [(SourceName, TableName b)] -> [(SourceName, TableName b)]
forall a. Ord a => [a] -> [a]
sort
        [(SourceName, TableName b)]
-> ([(SourceName, TableName b)] -> [[(SourceName, TableName b)]])
-> [[(SourceName, TableName b)]]
forall a b. a -> (a -> b) -> b
& [(SourceName, TableName b)] -> [[(SourceName, TableName b)]]
forall a. Eq a => [a] -> [[a]]
group
        [[(SourceName, TableName b)]]
-> ([[(SourceName, TableName b)]] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& ([(SourceName, TableName b)] -> Maybe (SourceName, TableName b))
-> [[(SourceName, TableName b)]] -> [(SourceName, TableName b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
          ( \case
              (SourceName, TableName b)
duplicate : (SourceName, TableName b)
_ : [(SourceName, TableName b)]
_ -> (SourceName, TableName b) -> Maybe (SourceName, TableName b)
forall a. a -> Maybe a
Just (SourceName, TableName b)
duplicate
              [(SourceName, TableName b)]
_ -> Maybe (SourceName, TableName b)
forall a. Maybe a
Nothing
          )

mkTrackTableV2ObjectId :: forall b. (Backend b) => TrackTableV2 b -> MetadataObjId
mkTrackTableV2ObjectId :: forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataObjId
mkTrackTableV2ObjectId TrackTableV2 {ttv2Table :: forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table = TrackTable {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
SourceName
TableName b
tSource :: forall (b :: BackendType). TrackTable b -> SourceName
tName :: forall (b :: BackendType). TrackTable b -> TableName b
tIsEnum :: forall (b :: BackendType). TrackTable b -> Bool
tApolloFedConfig :: forall (b :: BackendType).
TrackTable b -> Maybe ApolloFederationConfig
tLogicalModel :: forall (b :: BackendType). TrackTable b -> Maybe LogicalModelName
tSource :: SourceName
tName :: TableName b
tIsEnum :: Bool
tApolloFedConfig :: Maybe ApolloFederationConfig
tLogicalModel :: Maybe LogicalModelName
..}} =
  SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
tSource (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b
-> MetadataObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> MetadataObjId)
-> SourceMetadataObjId b -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
tName

trackExistingTablesOrViewsPhase2 ::
  forall b m.
  (MonadError QErr m, MonadWarnings m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  [TrackTableV2 b] ->
  m [TrackTableV2 b]
trackExistingTablesOrViewsPhase2 :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, MonadWarnings m, CacheRWM m, MetadataM m,
 BackendMetadata b) =>
[TrackTableV2 b] -> m [TrackTableV2 b]
trackExistingTablesOrViewsPhase2 [TrackTableV2 b]
tablesToTrack = do
  SchemaCache
schemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  -- Find and create warnings for tables with conflicting table names
  let errorsFromConflictingTables :: [(TrackTableV2 b, QErr)]
errorsFromConflictingTables = SchemaCache
-> (TrackTableV2 b -> Text)
-> [TrackTableV2 b]
-> [(TrackTableV2 b, QErr)]
forall a. SchemaCache -> (a -> Text) -> [a] -> [(a, QErr)]
findConflictingNodes SchemaCache
schemaCache (forall (b :: BackendType). Backend b => TableName b -> Text
snakeCaseTableName @b (TableName b -> Text)
-> (TrackTableV2 b -> TableName b) -> TrackTableV2 b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTable b -> TableName b
forall (b :: BackendType). TrackTable b -> TableName b
tName (TrackTable b -> TableName b)
-> (TrackTableV2 b -> TrackTable b)
-> TrackTableV2 b
-> TableName b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTableV2 b -> TrackTable b
forall (b :: BackendType). TrackTableV2 b -> TrackTable b
ttv2Table) [TrackTableV2 b]
tablesToTrack
  [(TrackTableV2 b, QErr)]
-> ((TrackTableV2 b, QErr) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(TrackTableV2 b, QErr)]
errorsFromConflictingTables (((TrackTableV2 b, QErr) -> m ()) -> m ())
-> ((TrackTableV2 b, QErr) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(TrackTableV2 b
trackTable, QErr
qErr) -> do
    let tableObjId :: MetadataObjId
tableObjId = TrackTableV2 b -> MetadataObjId
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataObjId
mkTrackTableV2ObjectId TrackTableV2 b
trackTable
    let message :: Text
message = QErr -> Text
qeError QErr
qErr
    MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCTrackTableFailed MetadataObjId
tableObjId Text
message

  let conflictingTables :: [TrackTableV2 b]
conflictingTables = (TrackTableV2 b, QErr) -> TrackTableV2 b
forall a b. (a, b) -> a
fst ((TrackTableV2 b, QErr) -> TrackTableV2 b)
-> [(TrackTableV2 b, QErr)] -> [TrackTableV2 b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TrackTableV2 b, QErr)]
errorsFromConflictingTables
  let nonConflictingTables :: [TrackTableV2 b]
nonConflictingTables = [TrackTableV2 b]
tablesToTrack [TrackTableV2 b]
-> ([TrackTableV2 b] -> [TrackTableV2 b]) -> [TrackTableV2 b]
forall a b. a -> (a -> b) -> b
& (TrackTableV2 b -> Bool) -> [TrackTableV2 b] -> [TrackTableV2 b]
forall a. (a -> Bool) -> [a] -> [a]
filter (TrackTableV2 b -> [TrackTableV2 b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TrackTableV2 b]
conflictingTables)

  -- Try tracking all non-conflicting tables
  let objectIds :: HashMap MetadataObjId (TrackTableV2 b)
objectIds = [(MetadataObjId, TrackTableV2 b)]
-> HashMap MetadataObjId (TrackTableV2 b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(MetadataObjId, TrackTableV2 b)]
 -> HashMap MetadataObjId (TrackTableV2 b))
-> [(MetadataObjId, TrackTableV2 b)]
-> HashMap MetadataObjId (TrackTableV2 b)
forall a b. (a -> b) -> a -> b
$ (\TrackTableV2 b
t -> (TrackTableV2 b -> MetadataObjId
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataObjId
mkTrackTableV2ObjectId TrackTableV2 b
t, TrackTableV2 b
t)) (TrackTableV2 b -> (MetadataObjId, TrackTableV2 b))
-> [TrackTableV2 b] -> [(MetadataObjId, TrackTableV2 b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TrackTableV2 b]
nonConflictingTables
  HashMap MetadataObjId (TrackTableV2 b)
successfulTables <- (TrackTableV2 b -> m MetadataModifier)
-> WarningCode
-> HashMap MetadataObjId (TrackTableV2 b)
-> m (HashMap MetadataObjId (TrackTableV2 b))
forall (m :: * -> *) a.
(CacheRWM m, MonadWarnings m, QErrM m, MetadataM m) =>
(a -> m MetadataModifier)
-> WarningCode
-> HashMap MetadataObjId a
-> m (HashMap MetadataObjId a)
tryBuildSchemaCacheAndWarnOnFailingObjects (MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataModifier -> m MetadataModifier)
-> (TrackTableV2 b -> MetadataModifier)
-> TrackTableV2 b
-> m MetadataModifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTableV2 b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
TrackTableV2 b -> MetadataModifier
mkTrackTableMetadataModifier) WarningCode
WCTrackTableFailed HashMap MetadataObjId (TrackTableV2 b)
objectIds
  [TrackTableV2 b] -> m [TrackTableV2 b]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TrackTableV2 b] -> m [TrackTableV2 b])
-> [TrackTableV2 b] -> m [TrackTableV2 b]
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (TrackTableV2 b) -> [TrackTableV2 b]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap MetadataObjId (TrackTableV2 b)
successfulTables

data UntrackTables b = UntrackTables
  { forall (b :: BackendType). UntrackTables b -> [UntrackTable b]
_utTables :: [UntrackTable b],
    forall (b :: BackendType). UntrackTables b -> AllowWarnings
_utAllowWarnings :: AllowWarnings
  }

instance (Backend b) => FromJSON (UntrackTables b) where
  parseJSON :: Value -> Parser (UntrackTables b)
parseJSON = String
-> (Object -> Parser (UntrackTables b))
-> Value
-> Parser (UntrackTables b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UntrackTables" ((Object -> Parser (UntrackTables b))
 -> Value -> Parser (UntrackTables b))
-> (Object -> Parser (UntrackTables b))
-> Value
-> Parser (UntrackTables b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [UntrackTable b] -> AllowWarnings -> UntrackTables b
forall (b :: BackendType).
[UntrackTable b] -> AllowWarnings -> UntrackTables b
UntrackTables
      ([UntrackTable b] -> AllowWarnings -> UntrackTables b)
-> Parser [UntrackTable b]
-> Parser (AllowWarnings -> UntrackTables b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser [UntrackTable b]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
      Parser (AllowWarnings -> UntrackTables b)
-> Parser AllowWarnings -> Parser (UntrackTables b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe AllowWarnings)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_warnings"
      Parser (Maybe AllowWarnings)
-> AllowWarnings -> Parser AllowWarnings
forall a. Parser (Maybe a) -> a -> Parser a
.!= AllowWarnings
AllowWarnings

runUntrackTablesQ ::
  forall b m.
  (CacheRWM m, QErrM m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  UntrackTables b ->
  m EncJSON
runUntrackTablesQ :: forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, QErrM m, MetadataM m, BackendMetadata b,
 BackendEventTrigger b, MonadIO m) =>
UntrackTables b -> m EncJSON
runUntrackTablesQ UntrackTables {[UntrackTable b]
AllowWarnings
_utTables :: forall (b :: BackendType). UntrackTables b -> [UntrackTable b]
_utAllowWarnings :: forall (b :: BackendType). UntrackTables b -> AllowWarnings
_utTables :: [UntrackTable b]
_utAllowWarnings :: AllowWarnings
..} = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(SourceName, TableName b)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SourceName, TableName b)]
duplicatedTables)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ let tables :: Text
tables = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\(SourceName
source, TableName b
tableName) -> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tableName) ((SourceName, TableName b) -> Text)
-> [(SourceName, TableName b)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceName, TableName b)]
duplicatedTables
       in Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"tables" (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
BadRequest (Text
"The following tables occur more than once in the request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tables)

  ([UntrackTable b]
successfulTables, MetadataWarnings
metadataWarnings) <- StateT MetadataWarnings m [UntrackTable b]
-> m ([UntrackTable b], MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m [UntrackTable b]
 -> m ([UntrackTable b], MetadataWarnings))
-> StateT MetadataWarnings m [UntrackTable b]
-> m ([UntrackTable b], MetadataWarnings)
forall a b. (a -> b) -> a -> b
$ do
    [UntrackTable b]
phase1SuccessfulTables <- ([[UntrackTable b]] -> [UntrackTable b])
-> StateT MetadataWarnings m [[UntrackTable b]]
-> StateT MetadataWarnings m [UntrackTable b]
forall a b.
(a -> b)
-> StateT MetadataWarnings m a -> StateT MetadataWarnings m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[UntrackTable b]] -> [UntrackTable b]
forall a. Monoid a => [a] -> a
mconcat (StateT MetadataWarnings m [[UntrackTable b]]
 -> StateT MetadataWarnings m [UntrackTable b])
-> ((UntrackTable b -> StateT MetadataWarnings m [UntrackTable b])
    -> StateT MetadataWarnings m [[UntrackTable b]])
-> (UntrackTable b -> StateT MetadataWarnings m [UntrackTable b])
-> StateT MetadataWarnings m [UntrackTable b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UntrackTable b]
-> (UntrackTable b -> StateT MetadataWarnings m [UntrackTable b])
-> StateT MetadataWarnings m [[UntrackTable b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [UntrackTable b]
_utTables ((UntrackTable b -> StateT MetadataWarnings m [UntrackTable b])
 -> StateT MetadataWarnings m [UntrackTable b])
-> (UntrackTable b -> StateT MetadataWarnings m [UntrackTable b])
-> StateT MetadataWarnings m [UntrackTable b]
forall a b. (a -> b) -> a -> b
$ \UntrackTable b
untrackTable -> do
      (forall (b :: BackendType) (m :: * -> *).
(CacheRM m, QErrM m, Backend b) =>
UntrackTable b -> m ()
untrackExistingTableOrViewPhase1 @b UntrackTable b
untrackTable StateT MetadataWarnings m ()
-> [UntrackTable b] -> StateT MetadataWarnings m [UntrackTable b]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [UntrackTable b
untrackTable])
        StateT MetadataWarnings m [UntrackTable b]
-> (QErr -> StateT MetadataWarnings m [UntrackTable b])
-> StateT MetadataWarnings m [UntrackTable b]
forall a.
StateT MetadataWarnings m a
-> (QErr -> StateT MetadataWarnings m a)
-> StateT MetadataWarnings m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \QErr
qErr -> do
          let tableObjId :: MetadataObjId
tableObjId = UntrackTable b -> MetadataObjId
forall (b :: BackendType).
Backend b =>
UntrackTable b -> MetadataObjId
mkUntrackTableObjectId UntrackTable b
untrackTable
          let message :: Text
message = QErr -> Text
qeError QErr
qErr
          MetadataWarning -> StateT MetadataWarnings m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> StateT MetadataWarnings m ())
-> MetadataWarning -> StateT MetadataWarnings m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCUntrackTableFailed MetadataObjId
tableObjId Text
message
          [UntrackTable b] -> StateT MetadataWarnings m [UntrackTable b]
forall a. a -> StateT MetadataWarnings m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    [UntrackTable b] -> StateT MetadataWarnings m [UntrackTable b]
forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, MonadWarnings m, MonadError QErr m, MetadataM m,
 BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
[UntrackTable b] -> m [UntrackTable b]
untrackExistingTablesOrViewsPhase2 [UntrackTable b]
phase1SuccessfulTables

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([UntrackTable b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UntrackTable b]
successfulTables)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Value -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail Code
InvalidConfiguration Text
"all tables failed to untrack" (MetadataWarnings -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataWarnings
metadataWarnings)

  case AllowWarnings
_utAllowWarnings of
    AllowWarnings
AllowWarnings -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AllowWarnings
DisallowWarnings ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MetadataWarnings -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MetadataWarnings
metadataWarnings)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Value -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (Text -> Code
CustomCode Text
"metadata-warnings") Text
"failed due to metadata warnings" (MetadataWarnings -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataWarnings
metadataWarnings)

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings MetadataWarnings
metadataWarnings
  where
    duplicatedTables :: [(SourceName, TableName b)]
    duplicatedTables :: [(SourceName, TableName b)]
duplicatedTables =
      [UntrackTable b]
_utTables
        [UntrackTable b]
-> ([UntrackTable b] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& (UntrackTable b -> (SourceName, TableName b))
-> [UntrackTable b] -> [(SourceName, TableName b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..} -> (SourceName
utSource, TableName b
utTable))
        [(SourceName, TableName b)]
-> ([(SourceName, TableName b)] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& [(SourceName, TableName b)] -> [(SourceName, TableName b)]
forall a. Ord a => [a] -> [a]
sort
        [(SourceName, TableName b)]
-> ([(SourceName, TableName b)] -> [[(SourceName, TableName b)]])
-> [[(SourceName, TableName b)]]
forall a b. a -> (a -> b) -> b
& [(SourceName, TableName b)] -> [[(SourceName, TableName b)]]
forall a. Eq a => [a] -> [[a]]
group
        [[(SourceName, TableName b)]]
-> ([[(SourceName, TableName b)]] -> [(SourceName, TableName b)])
-> [(SourceName, TableName b)]
forall a b. a -> (a -> b) -> b
& ([(SourceName, TableName b)] -> Maybe (SourceName, TableName b))
-> [[(SourceName, TableName b)]] -> [(SourceName, TableName b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
          ( \case
              (SourceName, TableName b)
duplicate : (SourceName, TableName b)
_ : [(SourceName, TableName b)]
_ -> (SourceName, TableName b) -> Maybe (SourceName, TableName b)
forall a. a -> Maybe a
Just (SourceName, TableName b)
duplicate
              [(SourceName, TableName b)]
_ -> Maybe (SourceName, TableName b)
forall a. Maybe a
Nothing
          )

mkUntrackTableObjectId :: forall b. (Backend b) => UntrackTable b -> MetadataObjId
mkUntrackTableObjectId :: forall (b :: BackendType).
Backend b =>
UntrackTable b -> MetadataObjId
mkUntrackTableObjectId UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..} =
  SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
utSource (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b
-> MetadataObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> MetadataObjId)
-> SourceMetadataObjId b -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
utTable

untrackExistingTablesOrViewsPhase2 ::
  forall b m.
  (CacheRWM m, MonadWarnings m, MonadError QErr m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  [UntrackTable b] ->
  m [UntrackTable b]
untrackExistingTablesOrViewsPhase2 :: forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, MonadWarnings m, MonadError QErr m, MetadataM m,
 BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
[UntrackTable b] -> m [UntrackTable b]
untrackExistingTablesOrViewsPhase2 [UntrackTable b]
untrackTables = do
  HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
untrackableTables <- ([Maybe
    (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
 -> HashMap
      MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
-> m [Maybe
        (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
-> m (HashMap
        MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
-> HashMap
     MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
 -> HashMap
      MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
-> ([Maybe
       (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
    -> [(MetadataObjId,
         (UntrackTable b, [SchemaObjId], [TriggerName]))])
-> [Maybe
      (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
-> HashMap
     MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe
   (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
-> [(MetadataObjId,
     (UntrackTable b, [SchemaObjId], [TriggerName]))]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes) (m [Maybe
      (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
 -> m (HashMap
         MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])))
-> (((MetadataObjId, UntrackTable b)
     -> m (Maybe
             (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
    -> m [Maybe
            (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))])
-> ((MetadataObjId, UntrackTable b)
    -> m (Maybe
            (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
-> m (HashMap
        MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MetadataObjId, UntrackTable b)]
-> ((MetadataObjId, UntrackTable b)
    -> m (Maybe
            (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
-> m [Maybe
        (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap MetadataObjId (UntrackTable b)
-> [(MetadataObjId, UntrackTable b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap MetadataObjId (UntrackTable b)
tablesToUntrack) (((MetadataObjId, UntrackTable b)
  -> m (Maybe
          (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
 -> m (HashMap
         MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])))
-> ((MetadataObjId, UntrackTable b)
    -> m (Maybe
            (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
-> m (HashMap
        MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
forall a b. (a -> b) -> a -> b
$ \(MetadataObjId
tableObjId, untrackTable :: UntrackTable b
untrackTable@UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..}) -> do
    ([SchemaObjId]
indirectDeps, [TriggerName]
triggers) <- UntrackTable b -> m ([SchemaObjId], [TriggerName])
forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m, MonadError QErr m) =>
UntrackTable b -> m ([SchemaObjId], [TriggerName])
getTableUntrackingInfo UntrackTable b
untrackTable
    let indirectDepsNotAlreadyBeingUntracked :: [SchemaObjId]
indirectDepsNotAlreadyBeingUntracked = (SchemaObjId -> Bool) -> [SchemaObjId] -> [SchemaObjId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (SchemaObjId -> Bool) -> SchemaObjId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaObjId -> Bool
isDepAlreadyGettingUntracked) [SchemaObjId]
indirectDeps
    -- If there are indirect dependencies to the table to untrack and we're not
    -- cascading the untrack, fail to untrack this table with a warning.
    -- But if the indirect dependencies are from tables we're already going to untrack
    -- then allow them, since they'll get untracked anyway.
    if [SchemaObjId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
indirectDepsNotAlreadyBeingUntracked Bool -> Bool -> Bool
|| Bool
utCascade
      then Maybe
  (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
-> m (Maybe
        (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName])))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
 -> m (Maybe
         (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))))
-> Maybe
     (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
-> m (Maybe
        (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName])))
forall a b. (a -> b) -> a -> b
$ (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
-> Maybe
     (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
forall a. a -> Maybe a
Just (MetadataObjId
tableObjId, (UntrackTable b
untrackTable, [SchemaObjId]
indirectDeps, [TriggerName]
triggers))
      else do
        let errorReasons :: Text
errorReasons = Text
"cannot drop due to the following dependent objects: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [SchemaObjId] -> Text
reportSchemaObjs [SchemaObjId]
indirectDeps
        MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCUntrackTableFailed MetadataObjId
tableObjId Text
errorReasons
        Maybe
  (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
-> m (Maybe
        (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName])))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (MetadataObjId, (UntrackTable b, [SchemaObjId], [TriggerName]))
forall a. Maybe a
Nothing

  -- Untrack the tables and all their indirect dependencies
  let mkMetadataModifier :: (UntrackTable b, [SchemaObjId], c) -> m MetadataModifier
mkMetadataModifier (UntrackTable b
untrackTable, [SchemaObjId]
indirectDeps, c
_triggers) = UntrackTable b -> [SchemaObjId] -> m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
UntrackTable b -> [SchemaObjId] -> m MetadataModifier
mkUntrackTableMetadataModifier UntrackTable b
untrackTable [SchemaObjId]
indirectDeps
  HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
successfullyUntrackedTables <- ((UntrackTable b, [SchemaObjId], [TriggerName])
 -> m MetadataModifier)
-> WarningCode
-> HashMap
     MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
-> m (HashMap
        MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName]))
forall (m :: * -> *) a.
(CacheRWM m, MonadWarnings m, QErrM m, MetadataM m) =>
(a -> m MetadataModifier)
-> WarningCode
-> HashMap MetadataObjId a
-> m (HashMap MetadataObjId a)
tryBuildSchemaCacheAndWarnOnFailingObjects (UntrackTable b, [SchemaObjId], [TriggerName])
-> m MetadataModifier
forall {b :: BackendType} {m :: * -> *} {c}.
(Backend b, MonadError QErr m) =>
(UntrackTable b, [SchemaObjId], c) -> m MetadataModifier
mkMetadataModifier WarningCode
WCUntrackTableFailed HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
untrackableTables

  -- drop all the hasura SQL triggers present on the untracked tables
  HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
-> ((UntrackTable b, [SchemaObjId], [TriggerName]) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
successfullyUntrackedTables (((UntrackTable b, [SchemaObjId], [TriggerName]) -> m ()) -> m ())
-> ((UntrackTable b, [SchemaObjId], [TriggerName]) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..}, [SchemaObjId]
_indirectDeps, [TriggerName]
triggers) -> do
    SourceConfig b
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @b SourceName
utSource
    [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 -> 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
utTable

  [UntrackTable b] -> m [UntrackTable b]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UntrackTable b] -> m [UntrackTable b])
-> [UntrackTable b] -> m [UntrackTable b]
forall a b. (a -> b) -> a -> b
$ (\(UntrackTable b
untrackTable, [SchemaObjId]
_indirectDeps, [TriggerName]
_triggers) -> UntrackTable b
untrackTable) ((UntrackTable b, [SchemaObjId], [TriggerName]) -> UntrackTable b)
-> [(UntrackTable b, [SchemaObjId], [TriggerName])]
-> [UntrackTable b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
-> [(UntrackTable b, [SchemaObjId], [TriggerName])]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap
  MetadataObjId (UntrackTable b, [SchemaObjId], [TriggerName])
successfullyUntrackedTables
  where
    tablesToUntrack :: HashMap MetadataObjId (UntrackTable b)
    tablesToUntrack :: HashMap MetadataObjId (UntrackTable b)
tablesToUntrack = [(MetadataObjId, UntrackTable b)]
-> HashMap MetadataObjId (UntrackTable b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(MetadataObjId, UntrackTable b)]
 -> HashMap MetadataObjId (UntrackTable b))
-> [(MetadataObjId, UntrackTable b)]
-> HashMap MetadataObjId (UntrackTable b)
forall a b. (a -> b) -> a -> b
$ (\UntrackTable b
tbl -> (UntrackTable b -> MetadataObjId
forall (b :: BackendType).
Backend b =>
UntrackTable b -> MetadataObjId
mkUntrackTableObjectId UntrackTable b
tbl, UntrackTable b
tbl)) (UntrackTable b -> (MetadataObjId, UntrackTable b))
-> [UntrackTable b] -> [(MetadataObjId, UntrackTable b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UntrackTable b]
untrackTables

    isDepAlreadyGettingUntracked :: SchemaObjId -> Bool
    isDepAlreadyGettingUntracked :: SchemaObjId -> Bool
isDepAlreadyGettingUntracked SchemaObjId
schemaObjDependency =
      case SchemaObjId -> Maybe MetadataObjId
tryGetTableMetadataObjId SchemaObjId
schemaObjDependency of
        Just MetadataObjId
tableObjId -> MetadataObjId -> HashMap MetadataObjId (UntrackTable b) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member MetadataObjId
tableObjId HashMap MetadataObjId (UntrackTable b)
tablesToUntrack
        Maybe MetadataObjId
Nothing -> Bool
False

    tryGetTableMetadataObjId :: SchemaObjId -> Maybe MetadataObjId
    tryGetTableMetadataObjId :: SchemaObjId -> Maybe MetadataObjId
tryGetTableMetadataObjId = \case
      SOSourceObj SourceName
sourceName AnyBackend SourceObjId
sourceObj ->
        let tableObjMaybe :: Maybe (AnyBackend SourceMetadataObjId)
tableObjMaybe = forall (c :: BackendType -> Constraint) (i :: BackendType -> *)
       (j :: BackendType -> *) (f :: * -> *).
(AllBackendsSatisfy c, Functor f) =>
AnyBackend i
-> (forall (b :: BackendType). c b => i b -> f (j b))
-> f (AnyBackend j)
AB.traverseBackend @Backend AnyBackend SourceObjId
sourceObj ((forall (b :: BackendType).
  Backend b =>
  SourceObjId b -> Maybe (SourceMetadataObjId b))
 -> Maybe (AnyBackend SourceMetadataObjId))
-> (forall (b :: BackendType).
    Backend b =>
    SourceObjId b -> Maybe (SourceMetadataObjId b))
-> Maybe (AnyBackend SourceMetadataObjId)
forall a b. (a -> b) -> a -> b
$ \case
              SOITable TableName b
tableName -> SourceMetadataObjId b -> Maybe (SourceMetadataObjId b)
forall a. a -> Maybe a
Just (SourceMetadataObjId b -> Maybe (SourceMetadataObjId b))
-> SourceMetadataObjId b -> Maybe (SourceMetadataObjId b)
forall a b. (a -> b) -> a -> b
$ TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable TableName b
tableName
              SOITableObj TableName b
tableName TableObjId b
_tableObj -> SourceMetadataObjId b -> Maybe (SourceMetadataObjId b)
forall a. a -> Maybe a
Just (SourceMetadataObjId b -> Maybe (SourceMetadataObjId b))
-> SourceMetadataObjId b -> Maybe (SourceMetadataObjId b)
forall a b. (a -> b) -> a -> b
$ TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable TableName b
tableName
              SourceObjId b
_ -> Maybe (SourceMetadataObjId b)
forall a. Maybe a
Nothing
         in (SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName) (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> Maybe (AnyBackend SourceMetadataObjId) -> Maybe MetadataObjId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnyBackend SourceMetadataObjId)
tableObjMaybe
      SchemaObjId
_ -> Maybe MetadataObjId
forall a. Maybe a
Nothing

runSetExistingTableIsEnumQ :: forall b m. (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) => SetTableIsEnum b -> m EncJSON
runSetExistingTableIsEnumQ :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
SetTableIsEnum b -> m EncJSON
runSetExistingTableIsEnumQ (SetTableIsEnum SourceName
source TableName b
tableName Bool
isEnum) = 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
$ forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
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 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
$ 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
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
tableName
    ASetter' Metadata (TableMetadata b)
-> ((Bool -> Identity Bool)
    -> TableMetadata b -> Identity (TableMetadata b))
-> (Bool -> Identity Bool)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> TableMetadata b -> f (TableMetadata b)
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

data SetTableCustomization b = SetTableCustomization
  { forall (b :: BackendType). SetTableCustomization b -> SourceName
_stcSource :: SourceName,
    forall (b :: BackendType). SetTableCustomization b -> TableName b
_stcTable :: TableName b,
    forall (b :: BackendType). 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
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> SetTableCustomization b -> ShowS
showsPrec :: Int -> SetTableCustomization b -> ShowS
$cshow :: forall (b :: BackendType).
Backend b =>
SetTableCustomization b -> String
show :: SetTableCustomization b -> String
$cshowList :: forall (b :: BackendType).
Backend b =>
[SetTableCustomization b] -> ShowS
showList :: [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
$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
/= :: 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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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
$cshowsPrec :: Int -> SetTableCustomFields -> ShowS
showsPrec :: Int -> SetTableCustomFields -> ShowS
$cshow :: SetTableCustomFields -> String
show :: SetTableCustomFields -> String
$cshowList :: [SetTableCustomFields] -> ShowS
showList :: [SetTableCustomFields] -> ShowS
Show, SetTableCustomFields -> SetTableCustomFields -> Bool
(SetTableCustomFields -> SetTableCustomFields -> Bool)
-> (SetTableCustomFields -> SetTableCustomFields -> Bool)
-> Eq SetTableCustomFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetTableCustomFields -> SetTableCustomFields -> Bool
== :: SetTableCustomFields -> SetTableCustomFields -> Bool
$c/= :: SetTableCustomFields -> SetTableCustomFields -> Bool
/= :: 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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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
HashMap.empty

runSetTableCustomFieldsQV2 ::
  (QErrM m, CacheRWM m, MetadataM m) => SetTableCustomFields -> m EncJSON
runSetTableCustomFieldsQV2 :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
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
$ 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 = 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
$ 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) (f :: * -> *).
Functor f =>
(TableConfig b -> f (TableConfig b))
-> TableMetadata b -> f (TableMetadata 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

runSetTableCustomization ::
  forall b m.
  (QErrM m, CacheRWM m, MetadataM m, Backend b) =>
  SetTableCustomization b ->
  m EncJSON
runSetTableCustomization :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m, Backend b) =>
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
$ 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
$ 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) (f :: * -> *).
Functor f =>
(TableConfig b -> f (TableConfig b))
-> TableMetadata b -> f (TableMetadata 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

untrackExistingTableOrViewPhase1 ::
  forall b m.
  (CacheRM m, QErrM m, Backend b) =>
  UntrackTable b ->
  m ()
untrackExistingTableOrViewPhase1 :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, QErrM m, Backend b) =>
UntrackTable b -> m ()
untrackExistingTableOrViewPhase1 (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
$ 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)

untrackExistingTableOrViewPhase2 ::
  forall b m.
  (CacheRWM m, QErrM m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  UntrackTable b ->
  m EncJSON
untrackExistingTableOrViewPhase2 :: forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, QErrM m, MetadataM m, BackendMetadata b,
 BackendEventTrigger b, MonadIO m) =>
UntrackTable b -> m EncJSON
untrackExistingTableOrViewPhase2 untrackTable :: UntrackTable b
untrackTable@(UntrackTable SourceName
source TableName b
tableName Bool
cascade) = do
  ([SchemaObjId]
indirectDeps, [TriggerName]
triggers) <- UntrackTable b -> m ([SchemaObjId], [TriggerName])
forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m, MonadError QErr m) =>
UntrackTable b -> m ([SchemaObjId], [TriggerName])
getTableUntrackingInfo UntrackTable b
untrackTable
  SourceConfig b
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @b SourceName
source

  -- Report batch with an error if cascade is not set
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall a. [a] -> 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 <- UntrackTable b -> [SchemaObjId] -> m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
UntrackTable b -> [SchemaObjId] -> m MetadataModifier
mkUntrackTableMetadataModifier UntrackTable b
untrackTable [SchemaObjId]
indirectDeps
  -- 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
    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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

getTableUntrackingInfo ::
  forall b m.
  (Backend b, CacheRM m, MonadError QErr m) =>
  UntrackTable b ->
  m ([SchemaObjId], [TriggerName])
getTableUntrackingInfo :: forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m, MonadError QErr m) =>
UntrackTable b -> m ([SchemaObjId], [TriggerName])
getTableUntrackingInfo UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..} = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  TableInfo b
sourceInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
utSource TableName b
utTable
  let triggers :: [TriggerName]
triggers = HashMap TriggerName (EventTriggerInfo b) -> [TriggerName]
forall k v. HashMap k v -> [k]
HashMap.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
utSource (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
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
utTable)
  let indirectDeps :: [SchemaObjId]
indirectDeps = (SchemaObjId -> Maybe SchemaObjId)
-> [SchemaObjId] -> [SchemaObjId]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe SchemaObjId -> Maybe SchemaObjId
getIndirectDep [SchemaObjId]
allDeps
  ([SchemaObjId], [TriggerName]) -> m ([SchemaObjId], [TriggerName])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SchemaObjId]
indirectDeps, [TriggerName]
triggers)
  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
        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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
utSource Bool -> Bool -> Bool
&& TableName b
utTable 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

-- | Creates a metadata modifier that untracks a table and the specified indirect dependencies
mkUntrackTableMetadataModifier ::
  forall b m.
  (Backend b, MonadError QErr m) =>
  UntrackTable b ->
  [SchemaObjId] ->
  m MetadataModifier
mkUntrackTableMetadataModifier :: forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
UntrackTable b -> [SchemaObjId] -> m MetadataModifier
mkUntrackTableMetadataModifier UntrackTable {Bool
SourceName
TableName b
utSource :: forall (b :: BackendType). UntrackTable b -> SourceName
utTable :: forall (b :: BackendType). UntrackTable b -> TableName b
utCascade :: forall (b :: BackendType). UntrackTable b -> Bool
utSource :: SourceName
utTable :: TableName b
utCascade :: Bool
..} [SchemaObjId]
indirectDeps = WriterT MetadataModifier m () -> m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT MetadataModifier m () -> m MetadataModifier)
-> WriterT MetadataModifier m () -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ 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
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> MetadataModifier
dropTableInMetadata @b SourceName
utSource TableName b
utTable

runUntrackTableQ ::
  forall b m.
  (CacheRWM m, QErrM m, MetadataM m, BackendMetadata b, BackendEventTrigger b, MonadIO m) =>
  UntrackTable b ->
  m EncJSON
runUntrackTableQ :: forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, QErrM m, MetadataM m, BackendMetadata b,
 BackendEventTrigger b, MonadIO m) =>
UntrackTable b -> m EncJSON
runUntrackTableQ UntrackTable b
q = do
  forall (b :: BackendType) (m :: * -> *).
(CacheRM m, QErrM m, Backend b) =>
UntrackTable b -> m ()
untrackExistingTableOrViewPhase1 @b UntrackTable b
q
  forall (b :: BackendType) (m :: * -> *).
(CacheRWM m, QErrM m, MetadataM m, BackendMetadata b,
 BackendEventTrigger b, MonadIO m) =>
UntrackTable b -> m EncJSON
untrackExistingTableOrViewPhase2 @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 CollectItem) arr,
    Inc.ArrowCache m arr,
    MonadIO m,
    MonadBaseControl IO m,
    BackendMetadata b
  ) =>
  ( SourceName,
    SourceConfig b,
    DBTablesMetadata b,
    [TableBuildInput b],
    Inc.Dependency Inc.InvalidationKey,
    NamingCase,
    LogicalModels b
  )
    `arr` HashMap.HashMap (TableName b) (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
buildTableCache :: forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, BackendMetadata b) =>
arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase,
   LogicalModels b)
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
buildTableCache = arr
  (SourceName, SourceConfig b,
   HashMap (TableName b) (DBTableMetadata b), [TableBuildInput b],
   Dependency InvalidationKey, NamingCase,
   InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
-> arr
     (SourceName, SourceConfig b,
      HashMap (TableName b) (DBTableMetadata b), [TableBuildInput b],
      Dependency InvalidationKey, NamingCase,
      InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
     (HashMap
        (TableName b)
        (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
forall a b. (Given Accesses => Eq a) => arr a b -> arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache proc (SourceName
source, SourceConfig b
sourceConfig, HashMap (TableName b) (DBTableMetadata b)
dbTablesMeta, [TableBuildInput b]
tableBuildInputs, Dependency InvalidationKey
reloadMetadataInvalidationKey, NamingCase
tCase, InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
logicalModels) -> do
  HashMap
  (TableName b)
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
rawTableInfos <-
    (|
      arr
  (a, (TableName b, (NonEmpty (TableBuildInput b), ())))
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> arr
     (a, (HashMap (TableName b) (NonEmpty (TableBuildInput b)), ()))
     (HashMap
        (TableName b)
        (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b))))
forall {a}.
arr
  (a, (TableName b, (NonEmpty (TableBuildInput b), ())))
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> arr
     (a, (HashMap (TableName b) (NonEmpty (TableBuildInput b)), ()))
     (HashMap
        (TableName b)
        (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b))))
forall k e a s b.
Hashable k =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
        ( \TableName b
tableName NonEmpty (TableBuildInput b)
tables ->
            (|
              ErrorA
  QErr arr (a, ()) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> arr
     (a, (MetadataObject, ()))
     (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
forall {a}.
ErrorA
  QErr arr (a, ()) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> arr
     (a, (MetadataObject, ()))
     (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
                ( 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
                    case TableName b
-> HashMap (TableName b) (DBTableMetadata b)
-> Maybe (DBTableMetadata b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (TableBuildInput b -> TableName b
forall (b :: BackendType). TableBuildInput b -> TableName b
_tbiName TableBuildInput b
table) HashMap (TableName b) (DBTableMetadata b)
dbTablesMeta of
                      Maybe (DBTableMetadata b)
Nothing ->
                        ErrorA
  QErr arr QErr (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall a. ErrorA QErr arr QErr a
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
<>> TableBuildInput b -> TableName b
forall (b :: BackendType). TableBuildInput b -> TableName b
_tbiName TableBuildInput b
table
                      Just DBTableMetadata b
metadataTable ->
                        ErrorA
  QErr
  arr
  (SourceName, TableBuildInput b, DBTableMetadata b, SourceConfig b,
   Dependency InvalidationKey,
   InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
buildRawTableInfo -< (SourceName
source, TableBuildInput b
table, DBTableMetadata b
metadataTable, SourceConfig b
sourceConfig, Dependency InvalidationKey
reloadMetadataInvalidationKey, InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
logicalModels)
                )
            |)
              (SourceName -> TableName b -> MetadataObject
mkTableMetadataObject SourceName
source TableName b
tableName)
        )
      |)
      ((TableBuildInput b -> TableName b)
-> [TableBuildInput b]
-> HashMap (TableName b) (NonEmpty (TableBuildInput b))
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k (NonEmpty v)
HashMap.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
  (TableName b)
  (Maybe (TableCoreInfoG b (RawColumnInfo b) (Column b)))
-> HashMap
     (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall a.
HashMap (TableName b) (Maybe a) -> HashMap (TableName b) a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap
  (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 a b.
(a -> Maybe b)
-> HashMap (TableName b) a -> HashMap (TableName b) b
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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableConfig b -> Maybe (TableConfig b)
forall a. a -> Maybe a
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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
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
  (TableName b)
  (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
tableInfos <-
    arr
  (Writer
     (Seq CollectItem)
     (HashMap
        (TableName b)
        (Maybe
           (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))))
  (HashMap
     (TableName b)
     (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
      -< HashMap
  (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> (TableCoreInfoG b (RawColumnInfo b) (Column b)
    -> WriterT
         (Seq CollectItem)
         Identity
         (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))))
-> Writer
     (Seq CollectItem)
     (HashMap
        (TableName b)
        (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap
  (TableName b) (TableCoreInfoG b (RawColumnInfo b) (Column b))
rawTableCache \TableCoreInfoG b (RawColumnInfo b) (Column b)
table -> MetadataObject
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) Identity)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> WriterT
     (Seq CollectItem)
     Identity
     (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (SourceName -> TableName b -> MetadataObject
mkTableMetadataObject SourceName
source (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)
table)) do
        HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
-> TableCoreInfoG b (RawColumnInfo b) (Column b)
-> NamingCase
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) Identity)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall (n :: * -> *).
QErrM n =>
HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
-> TableCoreInfoG b (RawColumnInfo b) (Column b)
-> NamingCase
-> n (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
processTableInfo HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables TableCoreInfoG b (RawColumnInfo b) (Column b)
table NamingCase
tCase
  arr
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< HashMap
  (TableName b)
  (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall a.
HashMap (TableName b) (Maybe a) -> HashMap (TableName b) a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap
  (TableName b)
  (Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
tableInfos
  where
    mkTableMetadataObject :: SourceName -> TableName b -> MetadataObject
mkTableMetadataObject 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
$ 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 a. ErrorA QErr arr QErr a
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
        ( SourceName,
          TableBuildInput b,
          DBTableMetadata b,
          SourceConfig b,
          Inc.Dependency Inc.InvalidationKey,
          LogicalModels b
        )
        (TableCoreInfoG b (RawColumnInfo b) (Column b))
    buildRawTableInfo :: ErrorA
  QErr
  arr
  (SourceName, TableBuildInput b, DBTableMetadata b, SourceConfig b,
   Dependency InvalidationKey,
   InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
buildRawTableInfo = ErrorA
  QErr
  arr
  (SourceName, TableBuildInput b, DBTableMetadata b, SourceConfig b,
   Dependency InvalidationKey,
   InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
  (TableCoreInfoG b (RawColumnInfo b) (Column b))
-> ErrorA
     QErr
     arr
     (SourceName, TableBuildInput b, DBTableMetadata b, SourceConfig b,
      Dependency InvalidationKey,
      InsOrdHashMap LogicalModelName (LogicalModelMetadata b))
     (TableCoreInfoG b (RawColumnInfo b) (Column b))
forall a b.
(Given Accesses => Eq a) =>
ErrorA QErr arr a b -> ErrorA QErr arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache proc (SourceName
sourceName, TableBuildInput b
tableBuildInput, DBTableMetadata b
metadataTable, SourceConfig b
sourceConfig, Dependency InvalidationKey
reloadMetadataInvalidationKey, InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
logicalModels) -> do
      let TableBuildInput TableName b
name Bool
isEnum TableConfig b
config Maybe ApolloFederationConfig
apolloFedConfig Maybe LogicalModelName
mLogicalModelName = TableBuildInput b
tableBuildInput
      [RawColumnInfo b]
columns <-
        ErrorA QErr arr (Either QErr [RawColumnInfo b]) [RawColumnInfo b]
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA
          -< case Maybe LogicalModelName
mLogicalModelName of
            Maybe LogicalModelName
Nothing ->
              -- No logical model specified: use columns from DB introspection
              [RawColumnInfo b] -> Either QErr [RawColumnInfo b]
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RawColumnInfo b] -> Either QErr [RawColumnInfo b])
-> [RawColumnInfo b] -> Either QErr [RawColumnInfo b]
forall a b. (a -> b) -> a -> b
$ DBTableMetadata b -> [RawColumnInfo b]
forall (b :: BackendType). DBTableMetadata b -> [RawColumnInfo b]
_ptmiColumns DBTableMetadata b
metadataTable
            Just LogicalModelName
logicalModelName -> do
              -- A logical model was specified: use columns from the logical model
              --
              -- If the source does not support schemaless tables then we throw an error.
              -- This is not strictly necessary - the logical model could be used even with sources
              -- that always provide a table schema.  For now, we want to limit this functionality to
              -- databases such as MongoDB that don't always provide a schema. In future we may want
              -- to relax this.
              Bool -> Either QErr () -> Either QErr ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (b :: BackendType). Backend b => SourceConfig b -> Bool
sourceSupportsSchemalessTables @b SourceConfig b
sourceConfig)
                (Either QErr () -> Either QErr ())
-> Either QErr () -> Either QErr ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Either QErr ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration (Text
"The source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not support schemaless tables")
              LogicalModelMetadata b
logicalModel <-
                LogicalModelName
-> InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
-> Maybe (LogicalModelMetadata b)
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup LogicalModelName
logicalModelName InsOrdHashMap LogicalModelName (LogicalModelMetadata b)
logicalModels
                  Maybe (LogicalModelMetadata b)
-> Either QErr (LogicalModelMetadata b)
-> Either QErr (LogicalModelMetadata b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> Either QErr (LogicalModelMetadata b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration (Text
"The logical mode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName
logicalModelName LogicalModelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" could not be found")
              LogicalModelMetadata b -> Either QErr [RawColumnInfo b]
logicalModelToRawColumnInfos LogicalModelMetadata b
logicalModel
      let columnMap :: HashMap FieldName (RawColumnInfo b)
columnMap = (RawColumnInfo b -> FieldName)
-> [RawColumnInfo b] -> HashMap FieldName (RawColumnInfo b)
forall k a. 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 <- do
        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 a. Eq a => ErrorA QErr arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq 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)
forall (m :: * -> *).
(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
            { _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,
              _tciRawColumns :: [RawColumnInfo b]
_tciRawColumns = [RawColumnInfo b]
columns
            }

    logicalModelToRawColumnInfos :: LogicalModelMetadata b -> Either QErr [RawColumnInfo b]
    logicalModelToRawColumnInfos :: LogicalModelMetadata b -> Either QErr [RawColumnInfo b]
logicalModelToRawColumnInfos = ((Int, LogicalModelField b) -> Either QErr (RawColumnInfo b))
-> [(Int, LogicalModelField b)] -> Either QErr [RawColumnInfo b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> LogicalModelField b -> Either QErr (RawColumnInfo b))
-> (Int, LogicalModelField b) -> Either QErr (RawColumnInfo b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> LogicalModelField b -> Either QErr (RawColumnInfo b)
logicalModelColumnFieldToRawColumnInfo) ([(Int, LogicalModelField b)] -> Either QErr [RawColumnInfo b])
-> (LogicalModelMetadata b -> [(Int, LogicalModelField b)])
-> LogicalModelMetadata b
-> Either QErr [RawColumnInfo b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [LogicalModelField b] -> [(Int, LogicalModelField b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([LogicalModelField b] -> [(Int, LogicalModelField b)])
-> (LogicalModelMetadata b -> [LogicalModelField b])
-> LogicalModelMetadata b
-> [(Int, LogicalModelField b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap (Column b) (LogicalModelField b)
-> [LogicalModelField b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap (Column b) (LogicalModelField b)
 -> [LogicalModelField b])
-> (LogicalModelMetadata b
    -> InsOrdHashMap (Column b) (LogicalModelField b))
-> LogicalModelMetadata b
-> [LogicalModelField b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
forall (b :: BackendType).
LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields

    logicalModelColumnFieldToRawColumnInfo :: Int -> LogicalModelField b -> Either QErr (RawColumnInfo b)
    logicalModelColumnFieldToRawColumnInfo :: Int -> LogicalModelField b -> Either QErr (RawColumnInfo b)
logicalModelColumnFieldToRawColumnInfo Int
position LogicalModelField {Maybe Text
Column b
LogicalModelType b
lmfName :: Column b
lmfType :: LogicalModelType b
lmfDescription :: Maybe Text
lmfName :: forall (b :: BackendType). LogicalModelField b -> Column b
lmfType :: forall (b :: BackendType).
LogicalModelField b -> LogicalModelType b
lmfDescription :: forall (b :: BackendType). LogicalModelField b -> Maybe Text
..} = do
      (RawColumnType b
rciType, Bool
rciIsNullable) <- LogicalModelType b -> Either QErr (RawColumnType b, Bool)
logicalModelTypeToRawColumnType LogicalModelType b
lmfType
      RawColumnInfo b -> Either QErr (RawColumnInfo b)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (RawColumnInfo b -> Either QErr (RawColumnInfo b))
-> RawColumnInfo b -> Either QErr (RawColumnInfo b)
forall a b. (a -> b) -> a -> b
$ RawColumnInfo
          { rciName :: Column b
rciName = Column b
lmfName,
            rciPosition :: Int
rciPosition = Int
position,
            rciDescription :: Maybe Description
rciDescription = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lmfDescription,
            rciMutability :: ColumnMutability
rciMutability = Bool -> Bool -> ColumnMutability
ColumnMutability Bool
False Bool
False, -- TODO
            Bool
RawColumnType b
rciType :: RawColumnType b
rciIsNullable :: Bool
rciType :: RawColumnType b
rciIsNullable :: Bool
..
          }

    logicalModelTypeToRawColumnType :: LogicalModelType b -> Either QErr (RawColumnType b, Bool)
    logicalModelTypeToRawColumnType :: LogicalModelType b -> Either QErr (RawColumnType b, Bool)
logicalModelTypeToRawColumnType = \case
      LogicalModelTypeScalar LogicalModelTypeScalarC {Bool
ScalarType b
lmtsScalar :: ScalarType b
lmtsNullable :: Bool
lmtsScalar :: forall (b :: BackendType). LogicalModelTypeScalar b -> ScalarType b
lmtsNullable :: forall (b :: BackendType). LogicalModelTypeScalar b -> Bool
..} ->
        (RawColumnType b, Bool) -> Either QErr (RawColumnType b, Bool)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarType b -> RawColumnType b
forall (b :: BackendType). ScalarType b -> RawColumnType b
RawColumnTypeScalar ScalarType b
lmtsScalar, Bool
lmtsNullable)
      LogicalModelTypeArray LogicalModelTypeArrayC {Bool
LogicalModelType b
lmtaArray :: LogicalModelType b
lmtaNullable :: Bool
lmtaArray :: forall (b :: BackendType).
LogicalModelTypeArray b -> LogicalModelType b
lmtaNullable :: forall (b :: BackendType). LogicalModelTypeArray b -> Bool
..} -> do
        XNestedObjects b
supportsNestedObjects <- forall (b :: BackendType).
Backend b =>
Either QErr (XNestedObjects b)
backendSupportsNestedObjects @b
        (RawColumnType b
nestedType, Bool
nestedIsNullable) <- LogicalModelType b -> Either QErr (RawColumnType b, Bool)
logicalModelTypeToRawColumnType LogicalModelType b
lmtaArray
        (RawColumnType b, Bool) -> Either QErr (RawColumnType b, Bool)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XNestedObjects b -> RawColumnType b -> Bool -> RawColumnType b
forall (b :: BackendType).
XNestedObjects b -> RawColumnType b -> Bool -> RawColumnType b
RawColumnTypeArray XNestedObjects b
supportsNestedObjects RawColumnType b
nestedType Bool
nestedIsNullable, Bool
lmtaNullable)
      LogicalModelTypeReference LogicalModelTypeReferenceC {Bool
LogicalModelName
lmtrReference :: LogicalModelName
lmtrNullable :: Bool
lmtrReference :: LogicalModelTypeReference -> LogicalModelName
lmtrNullable :: LogicalModelTypeReference -> Bool
..} -> do
        XNestedObjects b
supportsNestedObjects <- forall (b :: BackendType).
Backend b =>
Either QErr (XNestedObjects b)
backendSupportsNestedObjects @b
        (RawColumnType b, Bool) -> Either QErr (RawColumnType b, Bool)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XNestedObjects b -> Name -> RawColumnType b
forall (b :: BackendType).
XNestedObjects b -> Name -> RawColumnType b
RawColumnTypeObject XNestedObjects b
supportsNestedObjects (LogicalModelName -> Name
getLogicalModelName LogicalModelName
lmtrReference), Bool
lmtrNullable)

    -- Step 2: Process the raw table cache to replace Postgres column types with logical column
    -- types.
    processTableInfo ::
      (QErrM n) =>
      HashMap.HashMap (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues) ->
      TableCoreInfoG b (RawColumnInfo b) (Column b) ->
      NamingCase ->
      n (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
    processTableInfo :: forall (n :: * -> *).
QErrM n =>
HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
-> TableCoreInfoG b (RawColumnInfo b) (Column b)
-> NamingCase
-> n (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
processTableInfo HashMap
  (TableName b) (PrimaryKey b (Column b), TableConfig b, EnumValues)
enumTables TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo NamingCase
tCase = 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 (StructuredColumnInfo b)
columnInfoMap <-
        HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> n (FieldInfoMap
        (RawColumnInfo b, GQLNameIdentifier, Maybe Description))
forall (n :: * -> *).
QErrM n =>
HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> n (FieldInfoMap
        (RawColumnInfo b, GQLNameIdentifier, 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)
          n (FieldInfoMap
     (RawColumnInfo b, GQLNameIdentifier, Maybe Description))
-> (FieldInfoMap
      (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
    -> n (HashMap FieldName (StructuredColumnInfo b)))
-> n (HashMap FieldName (StructuredColumnInfo b))
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((RawColumnInfo b, GQLNameIdentifier, Maybe Description)
 -> n (StructuredColumnInfo b))
-> FieldInfoMap
     (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
-> n (HashMap FieldName (StructuredColumnInfo b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap FieldName a -> f (HashMap FieldName b)
traverse (NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
-> n (StructuredColumnInfo b)
forall (n :: * -> *).
QErrM n =>
NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
-> n (StructuredColumnInfo 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))
      [StructuredColumnInfo b] -> n ()
forall {f :: * -> *} {t :: * -> *} {b :: BackendType}.
(Foldable t, MonadError QErr f, ToTxt (Column b)) =>
t (StructuredColumnInfo b) -> f ()
assertNoDuplicateFieldNames (HashMap FieldName (StructuredColumnInfo b)
-> [StructuredColumnInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap FieldName (StructuredColumnInfo b)
columnInfoMap)

      Maybe (PrimaryKey b (ColumnInfo b))
primaryKey <- (PrimaryKey b (Column b) -> n (PrimaryKey b (ColumnInfo b)))
-> Maybe (PrimaryKey b (Column b))
-> n (Maybe (PrimaryKey b (ColumnInfo b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (HashMap FieldName (ColumnInfo b)
-> PrimaryKey b (Column b) -> n (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)
 -> PrimaryKey b (Column b) -> n (PrimaryKey b (ColumnInfo b)))
-> HashMap FieldName (ColumnInfo b)
-> PrimaryKey b (Column b)
-> n (PrimaryKey b (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ (StructuredColumnInfo b -> Maybe (ColumnInfo b))
-> HashMap FieldName (StructuredColumnInfo b)
-> HashMap FieldName (ColumnInfo b)
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapMaybe StructuredColumnInfo b -> Maybe (ColumnInfo b)
forall (b :: BackendType).
StructuredColumnInfo b -> Maybe (ColumnInfo b)
toScalarColumnInfo HashMap FieldName (StructuredColumnInfo 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 (StructuredColumnInfo b) (ColumnInfo b)
-> n (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        TableCoreInfoG b (RawColumnInfo b) (Column b)
rawInfo
          { _tciFieldInfoMap :: HashMap FieldName (StructuredColumnInfo b)
_tciFieldInfoMap = HashMap FieldName (StructuredColumnInfo 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 :: forall (n :: * -> *) a.
QErrM n =>
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 (f :: * -> *).
Functor f =>
(NESeq a1 -> f (NESeq a2))
-> PrimaryKey b a1 -> f (PrimaryKey b 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NESeq a -> f (NESeq b)
traverse) \Column b
columnName ->
      FieldName -> HashMap FieldName a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.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, GQLNameIdentifier, Maybe G.Description))
    collectColumnConfiguration :: forall (n :: * -> *).
QErrM n =>
HashMap FieldName (RawColumnInfo b)
-> TableConfig b
-> n (FieldInfoMap
        (RawColumnInfo b, GQLNameIdentifier, Maybe Description))
collectColumnConfiguration HashMap FieldName (RawColumnInfo b)
columns TableConfig {Maybe Name
HashMap (Column b) ColumnConfig
Comment
TableCustomRootFields
_tcCustomRootFields :: TableCustomRootFields
_tcColumnConfig :: HashMap (Column b) ColumnConfig
_tcCustomName :: Maybe Name
_tcComment :: Comment
_tcCustomRootFields :: forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcColumnConfig :: forall (b :: BackendType).
TableConfig b -> HashMap (Column b) ColumnConfig
_tcCustomName :: forall (b :: BackendType). TableConfig b -> Maybe Name
_tcComment :: forall (b :: BackendType). TableConfig b -> Comment
..} = 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 (forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @b) HashMap (Column b) ColumnConfig
_tcColumnConfig
      (FieldName
 -> These (RawColumnInfo b) ColumnConfig
 -> n (RawColumnInfo b, GQLNameIdentifier, Maybe Description))
-> HashMap FieldName (These (RawColumnInfo b) ColumnConfig)
-> n (FieldInfoMap
        (RawColumnInfo b, GQLNameIdentifier, Maybe Description))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.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, GQLNameIdentifier, Maybe Description))
-> These (RawColumnInfo b) ColumnConfig
-> n (RawColumnInfo b, GQLNameIdentifier, 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, GQLNameIdentifier, Maybe Description)
forall (n :: * -> *).
QErrM n =>
FieldName
-> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
extractColumnConfiguration FieldName
fieldName)
        (HashMap FieldName (RawColumnInfo b)
-> HashMap FieldName ColumnConfig
-> HashMap FieldName (These (RawColumnInfo b) ColumnConfig)
forall a b.
HashMap FieldName a
-> HashMap FieldName b -> HashMap FieldName (These a b)
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 :: forall (n :: * -> *).
QErrM n =>
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 a. a -> n a
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 a. a -> n a
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, GQLNameIdentifier, Maybe G.Description)
    extractColumnConfiguration :: forall (n :: * -> *).
QErrM n =>
FieldName
-> (RawColumnInfo b, ColumnConfig)
-> n (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
extractColumnConfiguration FieldName
fieldName (RawColumnInfo b
columnInfo, ColumnConfig {Maybe Name
Comment
_ccfgCustomName :: ColumnConfig -> Maybe Name
_ccfgCustomName :: Maybe Name
_ccfgComment :: Comment
_ccfgComment :: ColumnConfig -> Comment
..}) = do
      GQLNameIdentifier
name <- (Name -> GQLNameIdentifier
fromCustomName (Name -> GQLNameIdentifier)
-> Maybe Name -> Maybe GQLNameIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
_ccfgCustomName) Maybe GQLNameIdentifier
-> n GQLNameIdentifier -> n GQLNameIdentifier
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> n GQLNameIdentifier
forall (m :: * -> *).
MonadError QErr m =>
Text -> m GQLNameIdentifier
textToGQLIdentifier (FieldName -> Text
getFieldNameTxt FieldName
fieldName)
      (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
-> n (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawColumnInfo b
columnInfo, GQLNameIdentifier
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 ->
      HashMap.HashMap (Column b) (NonEmpty (EnumReference b)) ->
      TableName b ->
      (RawColumnInfo b, GQLNameIdentifier, Maybe G.Description) ->
      n (StructuredColumnInfo b)
    processColumnInfo :: forall (n :: * -> *).
QErrM n =>
NamingCase
-> HashMap (Column b) (NonEmpty (EnumReference b))
-> TableName b
-> (RawColumnInfo b, GQLNameIdentifier, Maybe Description)
-> n (StructuredColumnInfo b)
processColumnInfo NamingCase
tCase HashMap (Column b) (NonEmpty (EnumReference b))
tableEnumReferences TableName b
tableName (RawColumnInfo b
rawInfo, GQLNameIdentifier
name, Maybe Description
description) =
      Bool -> RawColumnType b -> n (StructuredColumnInfo b)
processRawColumnType (RawColumnInfo b -> Bool
forall (b :: BackendType). RawColumnInfo b -> Bool
rciIsNullable RawColumnInfo b
rawInfo) (RawColumnType b -> n (StructuredColumnInfo b))
-> RawColumnType b -> n (StructuredColumnInfo b)
forall a b. (a -> b) -> a -> b
$ RawColumnInfo b -> RawColumnType b
forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciType RawColumnInfo b
rawInfo
      where
        processRawColumnType :: Bool -> RawColumnType b -> n (StructuredColumnInfo b)
processRawColumnType Bool
isNullable = \case
          RawColumnTypeScalar ScalarType b
scalarType -> do
            ColumnType b
resolvedType <- ScalarType b -> n (ColumnType b)
resolveColumnType ScalarType b
scalarType
            StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (StructuredColumnInfo b -> n (StructuredColumnInfo b))
-> StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> StructuredColumnInfo b
forall (b :: BackendType). ColumnInfo b -> StructuredColumnInfo b
SCIScalarColumn
                ColumnInfo
                  { ciColumn :: Column b
ciColumn = Column b
pgCol,
                    ciName :: Name
ciName = NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
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 = Bool
isNullable,
                    ciDescription :: Maybe Description
ciDescription = Maybe Description
description,
                    ciMutability :: ColumnMutability
ciMutability = RawColumnInfo b -> ColumnMutability
forall (b :: BackendType). RawColumnInfo b -> ColumnMutability
rciMutability RawColumnInfo b
rawInfo
                  }
          RawColumnTypeObject XNestedObjects b
supportsNestedObjects Name
objectTypeName ->
            StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (StructuredColumnInfo b -> n (StructuredColumnInfo b))
-> StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NestedObjectInfo b -> StructuredColumnInfo b
SCIObjectColumn @b
                NestedObjectInfo
                  { _noiSupportsNestedObjects :: XNestedObjects b
_noiSupportsNestedObjects = XNestedObjects b
supportsNestedObjects,
                    _noiColumn :: Column b
_noiColumn = Column b
pgCol,
                    _noiName :: Name
_noiName = NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
name,
                    _noiType :: LogicalModelName
_noiType = Name -> LogicalModelName
LogicalModelName Name
objectTypeName,
                    _noiIsNullable :: Bool
_noiIsNullable = Bool
isNullable,
                    _noiDescription :: Maybe Description
_noiDescription = Maybe Description
description,
                    _noiMutability :: ColumnMutability
_noiMutability = RawColumnInfo b -> ColumnMutability
forall (b :: BackendType). RawColumnInfo b -> ColumnMutability
rciMutability RawColumnInfo b
rawInfo
                  }
          RawColumnTypeArray XNestedObjects b
supportsNestedArrays RawColumnType b
rawColumnType Bool
isNullable' -> do
            StructuredColumnInfo b
nestedColumnInfo <- Bool -> RawColumnType b -> n (StructuredColumnInfo b)
processRawColumnType Bool
isNullable' RawColumnType b
rawColumnType
            StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (StructuredColumnInfo b -> n (StructuredColumnInfo b))
-> StructuredColumnInfo b -> n (StructuredColumnInfo b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NestedArrayInfo b -> StructuredColumnInfo b
SCIArrayColumn @b
                NestedArrayInfo
                  { _naiSupportsNestedArrays :: XNestedObjects b
_naiSupportsNestedArrays = XNestedObjects b
supportsNestedArrays,
                    _naiIsNullable :: Bool
_naiIsNullable = Bool
isNullable,
                    _naiColumnInfo :: StructuredColumnInfo b
_naiColumnInfo = StructuredColumnInfo b
nestedColumnInfo
                  }
        pgCol :: Column b
pgCol = RawColumnInfo b -> Column b
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName RawColumnInfo b
rawInfo
        resolveColumnType :: ScalarType b -> n (ColumnType b)
resolveColumnType ScalarType b
scalarType =
          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
HashMap.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 a. a -> n a
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 ScalarType b
scalarType
            -- one reference? is an enum
            Just (EnumReference b
enumReference :| []) -> ColumnType b -> n (ColumnType b)
forall a. a -> n a
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 a. NonEmpty a -> [a]
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 (StructuredColumnInfo b) -> f ()
assertNoDuplicateFieldNames t (StructuredColumnInfo 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 -> [StructuredColumnInfo b] -> f ())
 -> HashMap Name [StructuredColumnInfo b] -> f (HashMap Name ()))
-> HashMap Name [StructuredColumnInfo b]
-> (Name -> [StructuredColumnInfo b] -> f ())
-> f (HashMap Name ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> [StructuredColumnInfo b] -> f ())
-> HashMap Name [StructuredColumnInfo b] -> f (HashMap Name ())
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey ((StructuredColumnInfo b -> Name)
-> t (StructuredColumnInfo b)
-> HashMap Name [StructuredColumnInfo b]
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
HashMap.groupOn StructuredColumnInfo b -> Name
forall (b :: BackendType). StructuredColumnInfo b -> Name
structuredColumnInfoName t (StructuredColumnInfo b)
columns) \Name
name [StructuredColumnInfo b]
columnsWithName ->
        case [StructuredColumnInfo b]
columnsWithName of
          StructuredColumnInfo b
one : StructuredColumnInfo b
two : [StructuredColumnInfo 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)
-> (StructuredColumnInfo b -> Column b)
-> StructuredColumnInfo b
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn (StructuredColumnInfo b -> Text)
-> NonEmpty (StructuredColumnInfo b) -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructuredColumnInfo b
one StructuredColumnInfo b
-> [StructuredColumnInfo b] -> NonEmpty (StructuredColumnInfo b)
forall a. a -> [a] -> NonEmpty a
:| StructuredColumnInfo b
two StructuredColumnInfo b
-> [StructuredColumnInfo b] -> [StructuredColumnInfo b]
forall a. a -> [a] -> [a]
: [StructuredColumnInfo 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
          [StructuredColumnInfo b]
_ -> () -> f ()
forall a. a -> f a
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 a. Maybe a -> Maybe a -> Maybe a
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
  { forall (b :: BackendType).
SetApolloFederationConfig b -> SourceName
_safcSource :: SourceName,
    forall (b :: BackendType).
SetApolloFederationConfig b -> TableName b
_safcTable :: TableName b,
    -- | Apollo Federation config for the table, setting `Nothing` would disable
    --   Apollo Federation support on the table.
    forall (b :: BackendType).
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 a b. Parser (a -> b) -> Parser a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser 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) =>
  SetApolloFederationConfig b ->
  m EncJSON
runSetApolloFederationConfig :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m, Backend b) =>
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
$ 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
$ 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
$ 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) (f :: * -> *).
Functor f =>
(Maybe ApolloFederationConfig -> f (Maybe ApolloFederationConfig))
-> TableMetadata b -> f (TableMetadata b)
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg