{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.Source
  ( -- * Metadata
    SourceInfo (..),
    BackendSourceInfo,
    SourceCache,
    unsafeSourceConfiguration,
    unsafeSourceFunctions,
    unsafeSourceInfo,
    unsafeSourceName,
    unsafeSourceTables,
    siConfiguration,
    siNativeQueries,
    siStoredProcedures,
    siLogicalModels,
    siFunctions,
    siName,
    siSourceKind,
    siQueryTagsConfig,
    siTables,
    siCustomization,
    siDbObjectsIntrospection,

    -- * Schema cache
    DBObjectsIntrospection (..),
    ScalarMap (..),

    -- * Source resolver
    SourceResolver,
    MonadResolveSource (..),
    MaintenanceModeVersion (..),

    -- * Health check
    SourceHealthCheckInfo (..),
    BackendSourceHealthCheckInfo,
    SourceHealthCheckCache,

    -- * Source pings
    SourcePingInfo (..),
    BackendSourcePingInfo,
    SourcePingCache,
  )
where

import Control.Lens hiding ((.=))
import Data.Aeson.Extended
import Data.Environment
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Database.PG.Query qualified as PG
import Hasura.Base.Error
import Hasura.Function.Cache
import Hasura.Logging qualified as L
import Hasura.LogicalModel.Cache (LogicalModelCache)
import Hasura.NativeQuery.Cache (NativeQueryCache)
import Hasura.Prelude
import Hasura.QueryTags.Types
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.HealthCheck
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.Metadata.Common (LogicalModels)
import Hasura.RQL.Types.SourceCustomization
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.StoredProcedure.Cache (StoredProcedureCache)
import Hasura.Table.Cache (DBTablesMetadata, TableCache)
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Metadata (FIXME: this grouping is inaccurate)

data SourceInfo b = SourceInfo
  { forall (b :: BackendType). SourceInfo b -> SourceName
_siName :: SourceName,
    forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siSourceKind :: BackendSourceKind b,
    forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables :: TableCache b,
    forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siFunctions :: FunctionCache b,
    forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siNativeQueries :: NativeQueryCache b,
    forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siStoredProcedures :: StoredProcedureCache b,
    forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siLogicalModels :: LogicalModelCache b,
    forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration :: ~(SourceConfig b),
    forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siQueryTagsConfig :: Maybe QueryTagsConfig,
    forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization :: ResolvedSourceCustomization,
    forall (b :: BackendType). SourceInfo b -> DBObjectsIntrospection b
_siDbObjectsIntrospection :: DBObjectsIntrospection b
  }

instance
  ( Backend b,
    ToJSON (TableCache b),
    ToJSON (FunctionCache b),
    ToJSON (NativeQueryCache b),
    ToJSON (StoredProcedureCache b),
    ToJSON (QueryTagsConfig),
    ToJSON (SourceCustomization)
  ) =>
  ToJSON (SourceInfo b)
  where
  toJSON :: SourceInfo b -> Value
toJSON (SourceInfo {Maybe QueryTagsConfig
TableCache b
FunctionCache b
StoredProcedureCache b
LogicalModelCache b
NativeQueryCache b
BackendSourceKind b
SourceName
SourceConfig b
ResolvedSourceCustomization
DBObjectsIntrospection b
_siName :: forall (b :: BackendType). SourceInfo b -> SourceName
_siSourceKind :: forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siFunctions :: forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siNativeQueries :: forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siStoredProcedures :: forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> DBObjectsIntrospection b
_siName :: SourceName
_siSourceKind :: BackendSourceKind b
_siTables :: TableCache b
_siFunctions :: FunctionCache b
_siNativeQueries :: NativeQueryCache b
_siStoredProcedures :: StoredProcedureCache b
_siLogicalModels :: LogicalModelCache b
_siConfiguration :: SourceConfig b
_siQueryTagsConfig :: Maybe QueryTagsConfig
_siCustomization :: ResolvedSourceCustomization
_siDbObjectsIntrospection :: DBObjectsIntrospection b
..}) =
    [Pair] -> Value
object
      [ Key
"name" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceName
_siName,
        Key
"tables" Key -> TableCache b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableCache b
_siTables,
        Key
"functions" Key -> FunctionCache b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= FunctionCache b
_siFunctions,
        Key
"native_queries" Key -> NativeQueryCache b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NativeQueryCache b
_siNativeQueries,
        Key
"stored_procedures" Key -> StoredProcedureCache b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoredProcedureCache b
_siStoredProcedures,
        Key
"configuration" Key -> SourceConfig b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceConfig b
_siConfiguration,
        Key
"query_tags_config" Key -> Maybe QueryTagsConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe QueryTagsConfig
_siQueryTagsConfig
      ]

type BackendSourceInfo = AB.AnyBackend SourceInfo

type SourceCache = HashMap SourceName BackendSourceInfo

-- Those functions cast the content of BackendSourceInfo in order to extract
-- a backend-specific SourceInfo. Ideally, those functions should NOT be used:
-- the rest of the code should be able to deal with any source, regardless of
-- backend, through usage of the appropriate typeclasses.
-- They are thus a temporary workaround as we work on generalizing code that
-- uses the schema cache.

unsafeSourceInfo :: forall b. (HasTag b) => BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo :: forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo = BackendSourceInfo -> Maybe (SourceInfo b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend

unsafeSourceName :: BackendSourceInfo -> SourceName
unsafeSourceName :: BackendSourceInfo -> SourceName
unsafeSourceName BackendSourceInfo
bsi = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend BackendSourceInfo
bsi SourceInfo b -> SourceName
forall (b :: BackendType). Backend b => SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName

unsafeSourceTables :: forall b. (HasTag b) => BackendSourceInfo -> Maybe (TableCache b)
unsafeSourceTables :: forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (TableCache b)
unsafeSourceTables = (SourceInfo b -> HashMap (TableName b) (TableInfo b))
-> Maybe (SourceInfo b)
-> Maybe (HashMap (TableName b) (TableInfo b))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables (Maybe (SourceInfo b)
 -> Maybe (HashMap (TableName b) (TableInfo b)))
-> (BackendSourceInfo -> Maybe (SourceInfo b))
-> BackendSourceInfo
-> Maybe (HashMap (TableName b) (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b

unsafeSourceFunctions :: forall b. (HasTag b) => BackendSourceInfo -> Maybe (FunctionCache b)
unsafeSourceFunctions :: forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (FunctionCache b)
unsafeSourceFunctions = (SourceInfo b -> HashMap (FunctionName b) (FunctionInfo b))
-> Maybe (SourceInfo b)
-> Maybe (HashMap (FunctionName b) (FunctionInfo b))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceInfo b -> HashMap (FunctionName b) (FunctionInfo b)
forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siFunctions (Maybe (SourceInfo b)
 -> Maybe (HashMap (FunctionName b) (FunctionInfo b)))
-> (BackendSourceInfo -> Maybe (SourceInfo b))
-> BackendSourceInfo
-> Maybe (HashMap (FunctionName b) (FunctionInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b

unsafeSourceConfiguration :: forall b. (HasTag b) => BackendSourceInfo -> Maybe (SourceConfig b)
unsafeSourceConfiguration :: forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceConfig b)
unsafeSourceConfiguration = (SourceInfo b -> SourceConfig b)
-> Maybe (SourceInfo b) -> Maybe (SourceConfig b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration (Maybe (SourceInfo b) -> Maybe (SourceConfig b))
-> (BackendSourceInfo -> Maybe (SourceInfo b))
-> BackendSourceInfo
-> Maybe (SourceConfig b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b

--------------------------------------------------------------------------------
-- Schema cache

-- | Contains metadata (introspection) from the database, used to build the
-- schema cache.  This type only contains results of introspecting DB objects,
-- i.e. the DB types specified by tables, functions, and scalars.  Notably, it
-- does not include the additional introspection that takes place on Postgres,
-- namely reading the contents of tables used as Enum Values -- see
-- @fetchAndValidateEnumValues@.
data DBObjectsIntrospection b = DBObjectsIntrospection
  { forall (b :: BackendType).
DBObjectsIntrospection b -> DBTablesMetadata b
_rsTables :: DBTablesMetadata b,
    forall (b :: BackendType).
DBObjectsIntrospection b -> DBFunctionsMetadata b
_rsFunctions :: DBFunctionsMetadata b,
    forall (b :: BackendType). DBObjectsIntrospection b -> ScalarMap b
_rsScalars :: ScalarMap b,
    forall (b :: BackendType).
DBObjectsIntrospection b -> LogicalModels b
_rsLogicalModels :: LogicalModels b
  }
  deriving (DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
(DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool)
-> (DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool)
-> Eq (DBObjectsIntrospection b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
== :: DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
/= :: DBObjectsIntrospection b -> DBObjectsIntrospection b -> Bool
Eq, (forall x.
 DBObjectsIntrospection b -> Rep (DBObjectsIntrospection b) x)
-> (forall x.
    Rep (DBObjectsIntrospection b) x -> DBObjectsIntrospection b)
-> Generic (DBObjectsIntrospection b)
forall x.
Rep (DBObjectsIntrospection b) x -> DBObjectsIntrospection b
forall x.
DBObjectsIntrospection b -> Rep (DBObjectsIntrospection b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (DBObjectsIntrospection b) x -> DBObjectsIntrospection b
forall (b :: BackendType) x.
DBObjectsIntrospection b -> Rep (DBObjectsIntrospection b) x
$cfrom :: forall (b :: BackendType) x.
DBObjectsIntrospection b -> Rep (DBObjectsIntrospection b) x
from :: forall x.
DBObjectsIntrospection b -> Rep (DBObjectsIntrospection b) x
$cto :: forall (b :: BackendType) x.
Rep (DBObjectsIntrospection b) x -> DBObjectsIntrospection b
to :: forall x.
Rep (DBObjectsIntrospection b) x -> DBObjectsIntrospection b
Generic)

instance (Backend b) => FromJSON (DBObjectsIntrospection b) where
  parseJSON :: Value -> Parser (DBObjectsIntrospection b)
parseJSON = String
-> (Object -> Parser (DBObjectsIntrospection b))
-> Value
-> Parser (DBObjectsIntrospection b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DBObjectsIntrospection" \Object
o -> do
    -- "tables": [["<table-1>", "<table-metadata-1>"], ["<table-2>", "<table-metadata-2>"]]
    [(TableName b, DBTableMetadata b)]
tables <- Object
o Object -> Key -> Parser [(TableName b, DBTableMetadata b)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
    [(FunctionName b, FunctionOverloads b)]
functions <- Object
o Object -> Key -> Parser [(FunctionName b, FunctionOverloads b)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"functions"
    [(Name, ScalarType b)]
scalars <- Object
o Object -> Key -> Parser [(Name, ScalarType b)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scalars"
    [(LogicalModelName, LogicalModelMetadata b)]
logicalModels <- Object
o Object
-> Key
-> Parser (Maybe [(LogicalModelName, LogicalModelMetadata b)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logical_models" Parser (Maybe [(LogicalModelName, LogicalModelMetadata b)])
-> [(LogicalModelName, LogicalModelMetadata b)]
-> Parser [(LogicalModelName, LogicalModelMetadata b)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [(LogicalModelName, LogicalModelMetadata b)]
forall a. Monoid a => a
mempty
    DBObjectsIntrospection b -> Parser (DBObjectsIntrospection b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      DBObjectsIntrospection
        { _rsTables :: DBTablesMetadata b
_rsTables = [(TableName b, DBTableMetadata b)] -> DBTablesMetadata b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(TableName b, DBTableMetadata b)]
tables,
          _rsFunctions :: DBFunctionsMetadata b
_rsFunctions = [(FunctionName b, FunctionOverloads b)] -> DBFunctionsMetadata b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(FunctionName b, FunctionOverloads b)]
functions,
          _rsScalars :: ScalarMap b
_rsScalars = HashMap Name (ScalarType b) -> ScalarMap b
forall (b :: BackendType).
HashMap Name (ScalarType b) -> ScalarMap b
ScalarMap (HashMap Name (ScalarType b) -> ScalarMap b)
-> HashMap Name (ScalarType b) -> ScalarMap b
forall a b. (a -> b) -> a -> b
$ [(Name, ScalarType b)] -> HashMap Name (ScalarType b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Name, ScalarType b)]
scalars,
          _rsLogicalModels :: LogicalModels b
_rsLogicalModels = [(LogicalModelName, LogicalModelMetadata b)] -> LogicalModels b
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(LogicalModelName, LogicalModelMetadata b)]
logicalModels
        }

instance (Backend b) => ToJSON (DBObjectsIntrospection b) where
  toJSON :: DBObjectsIntrospection b -> Value
toJSON (DBObjectsIntrospection DBTablesMetadata b
tables DBFunctionsMetadata b
functions (ScalarMap HashMap Name (ScalarType b)
scalars) LogicalModels b
logicalModels) =
    -- "tables": [["<table-1>", "<table-metadata-1>"], ["<table-2>", "<table-metadata-2>"]]
    [Pair] -> Value
object
      [ Key
"tables" Key -> [(TableName b, DBTableMetadata b)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DBTablesMetadata b -> [(TableName b, DBTableMetadata b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList DBTablesMetadata b
tables,
        Key
"functions" Key -> [(FunctionName b, FunctionOverloads b)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DBFunctionsMetadata b -> [(FunctionName b, FunctionOverloads b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList DBFunctionsMetadata b
functions,
        Key
"scalars" Key -> [(Name, ScalarType b)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashMap Name (ScalarType b) -> [(Name, ScalarType b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Name (ScalarType b)
scalars,
        Key
"logical_models" Key -> [(LogicalModelName, LogicalModelMetadata b)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= LogicalModels b -> [(LogicalModelName, LogicalModelMetadata b)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList LogicalModels b
logicalModels
      ]

instance (L.ToEngineLog (DBObjectsIntrospection b) L.Hasura) where
  toEngineLog :: DBObjectsIntrospection b -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog DBObjectsIntrospection b
_ = (LogLevel
L.LevelDebug, EngineLogType Hasura
L.ELTStartup, Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
rsLog)
    where
      rsLog :: Value
rsLog =
        [Pair] -> Value
object
          [ Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"resolve_source" :: Text),
            Key
"info" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"Successfully resolved source" :: Text)
          ]

-- | A map from GraphQL name to equivalent scalar type for a given backend.
newtype ScalarMap b = ScalarMap (HashMap G.Name (ScalarType b))
  deriving newtype (NonEmpty (ScalarMap b) -> ScalarMap b
ScalarMap b -> ScalarMap b -> ScalarMap b
(ScalarMap b -> ScalarMap b -> ScalarMap b)
-> (NonEmpty (ScalarMap b) -> ScalarMap b)
-> (forall b. Integral b => b -> ScalarMap b -> ScalarMap b)
-> Semigroup (ScalarMap b)
forall b. Integral b => b -> ScalarMap b -> ScalarMap b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (b :: BackendType). NonEmpty (ScalarMap b) -> ScalarMap b
forall (b :: BackendType).
ScalarMap b -> ScalarMap b -> ScalarMap b
forall (b :: BackendType) b.
Integral b =>
b -> ScalarMap b -> ScalarMap b
$c<> :: forall (b :: BackendType).
ScalarMap b -> ScalarMap b -> ScalarMap b
<> :: ScalarMap b -> ScalarMap b -> ScalarMap b
$csconcat :: forall (b :: BackendType). NonEmpty (ScalarMap b) -> ScalarMap b
sconcat :: NonEmpty (ScalarMap b) -> ScalarMap b
$cstimes :: forall (b :: BackendType) b.
Integral b =>
b -> ScalarMap b -> ScalarMap b
stimes :: forall b. Integral b => b -> ScalarMap b -> ScalarMap b
Semigroup, Semigroup (ScalarMap b)
ScalarMap b
Semigroup (ScalarMap b)
-> ScalarMap b
-> (ScalarMap b -> ScalarMap b -> ScalarMap b)
-> ([ScalarMap b] -> ScalarMap b)
-> Monoid (ScalarMap b)
[ScalarMap b] -> ScalarMap b
ScalarMap b -> ScalarMap b -> ScalarMap b
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (b :: BackendType). Semigroup (ScalarMap b)
forall (b :: BackendType). ScalarMap b
forall (b :: BackendType). [ScalarMap b] -> ScalarMap b
forall (b :: BackendType).
ScalarMap b -> ScalarMap b -> ScalarMap b
$cmempty :: forall (b :: BackendType). ScalarMap b
mempty :: ScalarMap b
$cmappend :: forall (b :: BackendType).
ScalarMap b -> ScalarMap b -> ScalarMap b
mappend :: ScalarMap b -> ScalarMap b -> ScalarMap b
$cmconcat :: forall (b :: BackendType). [ScalarMap b] -> ScalarMap b
mconcat :: [ScalarMap b] -> ScalarMap b
Monoid)

deriving stock instance (Backend b) => Eq (ScalarMap b)

--------------------------------------------------------------------------------
-- Source resolver

-- | FIXME: this should be either in 'BackendMetadata', or into a new dedicated
-- 'BackendResolve', instead of listing backends explicitly. It could also be
-- moved to the app level.
type SourceResolver b =
  Environment -> SourceName -> SourceConnConfiguration b -> IO (Either QErr (SourceConfig b))

class (Monad m) => MonadResolveSource m where
  getPGSourceResolver :: m (SourceResolver ('Postgres 'Vanilla))
  getMSSQLSourceResolver :: m (SourceResolver 'MSSQL)

instance (MonadResolveSource m) => MonadResolveSource (ExceptT e m) where
  getPGSourceResolver :: ExceptT e m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
-> ExceptT
     e
     m
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: ExceptT e m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
-> ExceptT
     e
     m
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

instance (MonadResolveSource m) => MonadResolveSource (ReaderT r m) where
  getPGSourceResolver :: ReaderT r m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
-> ReaderT
     r
     m
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: ReaderT r m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
-> ReaderT
     r
     m
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

instance (MonadResolveSource m) => MonadResolveSource (StateT s m) where
  getPGSourceResolver :: StateT s m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
-> StateT
     s
     m
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: StateT s m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
-> StateT
     s
     m
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

instance (MonadResolveSource m) => MonadResolveSource (Tracing.TraceT m) where
  getPGSourceResolver :: TraceT m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
-> TraceT
     m
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: TraceT m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
-> TraceT
     m
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

instance (MonadResolveSource m) => MonadResolveSource (PG.TxET QErr m) where
  getPGSourceResolver :: TxET QErr m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
-> TxET
     QErr
     m
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> TxET QErr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: TxET QErr m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
-> TxET
     QErr
     m
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *) a. Monad m => m a -> TxET QErr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

-- FIXME: why is this here?
data MaintenanceModeVersion
  = -- | should correspond to the source catalog version from which the user
    -- is migrating from
    PreviousMMVersion
  | -- | should correspond to the latest source catalog version
    CurrentMMVersion
  deriving (Int -> MaintenanceModeVersion -> ShowS
[MaintenanceModeVersion] -> ShowS
MaintenanceModeVersion -> String
(Int -> MaintenanceModeVersion -> ShowS)
-> (MaintenanceModeVersion -> String)
-> ([MaintenanceModeVersion] -> ShowS)
-> Show MaintenanceModeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaintenanceModeVersion -> ShowS
showsPrec :: Int -> MaintenanceModeVersion -> ShowS
$cshow :: MaintenanceModeVersion -> String
show :: MaintenanceModeVersion -> String
$cshowList :: [MaintenanceModeVersion] -> ShowS
showList :: [MaintenanceModeVersion] -> ShowS
Show, MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
(MaintenanceModeVersion -> MaintenanceModeVersion -> Bool)
-> (MaintenanceModeVersion -> MaintenanceModeVersion -> Bool)
-> Eq MaintenanceModeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
== :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
$c/= :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
/= :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
Eq)

-------------------------------------------------------------------------------
-- Source health check

data SourceHealthCheckInfo b = SourceHealthCheckInfo
  { forall (b :: BackendType). SourceHealthCheckInfo b -> SourceName
_shciName :: SourceName,
    forall (b :: BackendType).
SourceHealthCheckInfo b -> SourceConnConfiguration b
_shciConnection :: SourceConnConfiguration b,
    forall (b :: BackendType).
SourceHealthCheckInfo b -> HealthCheckConfig b
_shciHealthCheck :: HealthCheckConfig b
  }

type BackendSourceHealthCheckInfo = AB.AnyBackend SourceHealthCheckInfo

type SourceHealthCheckCache = HashMap SourceName BackendSourceHealthCheckInfo

-------------------------------------------------------------------------------
-- Source pings

data SourcePingInfo b = SourcePingInfo
  { forall (b :: BackendType). SourcePingInfo b -> SourceName
_spiName :: SourceName,
    forall (b :: BackendType).
SourcePingInfo b -> SourceConnConfiguration b
_spiConnection :: SourceConnConfiguration b
  }

type BackendSourcePingInfo = AB.AnyBackend SourcePingInfo

type SourcePingCache = HashMap SourceName BackendSourcePingInfo

$(makeLenses ''SourceInfo)