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

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

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

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

import Control.Lens hiding ((.=))
import Data.Aeson.Extended
import Database.PG.Query qualified as Q
import Hasura.Base.Error
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.QueryTags
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.SQL.Tag
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Metadata

data SourceInfo b = SourceInfo
  { SourceInfo b -> SourceName
_siName :: SourceName,
    SourceInfo b -> TableCache b
_siTables :: TableCache b,
    SourceInfo b -> FunctionCache b
_siFunctions :: FunctionCache b,
    SourceInfo b -> SourceConfig b
_siConfiguration :: SourceConfig b,
    SourceInfo b -> Maybe QueryTagsConfig
_siQueryTagsConfig :: Maybe QueryTagsConfig,
    SourceInfo b -> SourceCustomization
_siCustomization :: SourceCustomization
  }
  deriving ((forall x. SourceInfo b -> Rep (SourceInfo b) x)
-> (forall x. Rep (SourceInfo b) x -> SourceInfo b)
-> Generic (SourceInfo b)
forall x. Rep (SourceInfo b) x -> SourceInfo b
forall x. SourceInfo b -> Rep (SourceInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SourceInfo b) x -> SourceInfo b
forall (b :: BackendType) x. SourceInfo b -> Rep (SourceInfo b) x
$cto :: forall (b :: BackendType) x. Rep (SourceInfo b) x -> SourceInfo b
$cfrom :: forall (b :: BackendType) x. SourceInfo b -> Rep (SourceInfo b) x
Generic)

$(makeLenses ''SourceInfo)

instance
  ( Backend b,
    ToJSON (TableCache b),
    ToJSON (FunctionCache b),
    ToJSON (SourceConfig b),
    ToJSON (QueryTagsConfig),
    ToJSON (SourceCustomization)
  ) =>
  ToJSON (SourceInfo b)
  where
  toJSON :: SourceInfo b -> Value
toJSON = Options -> SourceInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

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 :: 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 = BackendSourceInfo
-> (forall (b :: BackendType).
    Backend b =>
    SourceInfo b -> SourceName)
-> SourceName
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 forall (b :: BackendType). Backend b => SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
go
  where
    go :: SourceInfo b -> SourceName
go (SourceInfo SourceName
name TableCache b
_ FunctionCache b
_ SourceConfig b
_ Maybe QueryTagsConfig
_ SourceCustomization
_) = SourceName
name

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

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

unsafeSourceConfiguration :: forall b. HasTag b => BackendSourceInfo -> Maybe (SourceConfig b)
unsafeSourceConfiguration :: BackendSourceInfo -> Maybe (SourceConfig b)
unsafeSourceConfiguration = (SourceInfo b -> SourceConfig b)
-> Maybe (SourceInfo b) -> Maybe (SourceConfig 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
. HasTag b => BackendSourceInfo -> Maybe (SourceInfo b)
forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b

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

-- | Contains Postgres connection configuration and essential metadata from the
-- database to build schema cache for tables and function.
data ResolvedSource b = ResolvedSource
  { ResolvedSource b -> SourceConfig b
_rsConfig :: SourceConfig b,
    ResolvedSource b -> SourceTypeCustomization
_rsCustomization :: SourceTypeCustomization,
    ResolvedSource b -> DBTablesMetadata b
_rsTables :: DBTablesMetadata b,
    ResolvedSource b -> DBFunctionsMetadata b
_rsFunctions :: DBFunctionsMetadata b,
    ResolvedSource b -> ScalarMap b
_rsScalars :: ScalarMap b
  }

instance (L.ToEngineLog (ResolvedSource b) L.Hasura) where
  toEngineLog :: ResolvedSource b -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog ResolvedSource 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
.= (Text
"resolve_source" :: Text),
            Key
"info" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Successfully resolved source" :: Text)
          ]

-- | A map from GraphQL name to equivalent scalar type for a given backend.
data ScalarMap b where
  ScalarMap :: Backend b => HashMap G.Name (ScalarType b) -> ScalarMap b

instance Backend b => Semigroup (ScalarMap b) where
  ScalarMap HashMap Name (ScalarType b)
s1 <> :: ScalarMap b -> ScalarMap b -> ScalarMap b
<> ScalarMap HashMap Name (ScalarType b)
s2 = HashMap Name (ScalarType b) -> ScalarMap b
forall (b :: BackendType).
Backend b =>
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
$ HashMap Name (ScalarType b)
s1 HashMap Name (ScalarType b)
-> HashMap Name (ScalarType b) -> HashMap Name (ScalarType b)
forall a. Semigroup a => a -> a -> a
<> HashMap Name (ScalarType b)
s2

instance Backend b => Monoid (ScalarMap b) where
  mempty :: ScalarMap b
mempty = HashMap Name (ScalarType b) -> ScalarMap b
forall (b :: BackendType).
Backend b =>
HashMap Name (ScalarType b) -> ScalarMap b
ScalarMap HashMap Name (ScalarType b)
forall a. Monoid a => a
mempty

--------------------------------------------------------------------------------
-- 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 =
  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 (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
-> ExceptT
     e
     m
     (SourceName
      -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: ExceptT e m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
-> ExceptT
     e
     m
     (SourceName
      -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
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 (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
-> ReaderT
     r
     m
     (SourceName
      -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: ReaderT r m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
-> ReaderT
     r
     m
     (SourceName
      -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver

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

instance (MonadResolveSource m) => MonadResolveSource (Q.TxET QErr m) where
  getPGSourceResolver :: TxET QErr m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = m (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
-> TxET
     QErr
     m
     (SourceName
      -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
  getMSSQLSourceResolver :: TxET QErr m (SourceResolver 'MSSQL)
getMSSQLSourceResolver = m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
-> TxET
     QErr
     m
     (SourceName
      -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
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
showList :: [MaintenanceModeVersion] -> ShowS
$cshowList :: [MaintenanceModeVersion] -> ShowS
show :: MaintenanceModeVersion -> String
$cshow :: MaintenanceModeVersion -> String
showsPrec :: Int -> MaintenanceModeVersion -> ShowS
$cshowsPrec :: Int -> MaintenanceModeVersion -> ShowS
Show, MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
(MaintenanceModeVersion -> MaintenanceModeVersion -> Bool)
-> (MaintenanceModeVersion -> MaintenanceModeVersion -> Bool)
-> Eq MaintenanceModeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
$c/= :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
== :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
$c== :: MaintenanceModeVersion -> MaintenanceModeVersion -> Bool
Eq)