2022-09-05 05:42:59 +03:00
{- # LANGUAGE Arrows # -}
2022-02-25 19:08:18 +03:00
{- # OPTIONS_GHC - fno - warn - orphans # -}
2023-04-13 04:29:15 +03:00
module Hasura.Backends.DataConnector.Adapter.Metadata ( requestDatabaseSchema ) where
2022-02-25 19:08:18 +03:00
2022-09-05 05:42:59 +03:00
import Control.Arrow.Extended
Rewrite `Tracing` to allow for only one `TraceT` in the entire stack.
This PR is on top of #7789.
### Description
This PR entirely rewrites the API of the Tracing library, to make `interpTraceT` a thing of the past. Before this change, we ran traces by sticking a `TraceT` on top of whatever we were doing. This had several major drawbacks:
- we were carrying a bunch of `TraceT` across the codebase, and the entire codebase had to know about it
- we needed to carry a second class constraint around (`HasReporterM`) to be able to run all of those traces
- we kept having to do stack rewriting with `interpTraceT`, which went from inconvenient to horrible
- we had to declare several behavioral instances on `TraceT m`
This PR rewrite all of `Tracing` using a more conventional model: there is ONE `TraceT` at the bottom of the stack, and there is an associated class constraint `MonadTrace`: any part of the code that happens to satisfy `MonadTrace` is able to create new traces. We NEVER have to do stack rewriting, `interpTraceT` is gone, and `TraceT` and `Reporter` become implementation details that 99% of the code is blissfully unaware of: code that needs to do tracing only needs to declare that the monad in which it operates implements `MonadTrace`.
In doing so, this PR revealed **several bugs in the codebase**: places where we were expecting to trace something, but due to the default instance of `HasReporterM IO` we would actually not do anything. This PR also splits the code of `Tracing` in more byte-sized modules, with the goal of potentially moving to `server/lib` down the line.
### Remaining work
This PR is a draft; what's left to do is:
- [x] make Pro compile; i haven't updated `HasuraPro/Main` yet
- [x] document Tracing by writing a note that explains how to use the library, and the meaning of "reporter", "trace" and "span", as well as the pitfalls
- [x] discuss some of the trade-offs in the implementation, which is why i'm opening this PR already despite it not fully building yet
- [x] it depends on #7789 being merged first
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7791
GitOrigin-RevId: cadd32d039134c93ddbf364599a2f4dd988adea8
2023-03-13 20:37:16 +03:00
import Control.Monad.Trans.Control
2022-04-14 05:06:07 +03:00
import Data.Aeson qualified as J
2022-06-08 18:31:28 +03:00
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
2023-05-17 11:03:23 +03:00
import Data.Bifunctor ( bimap )
2022-04-14 05:06:07 +03:00
import Data.Environment ( Environment )
2023-04-05 23:14:35 +03:00
import Data.Has ( Has ( getter ) )
2023-05-19 07:47:12 +03:00
import Data.HashMap.Strict qualified as HashMap
2022-09-05 05:42:59 +03:00
import Data.HashMap.Strict.Extended qualified as HashMap
2022-08-24 00:46:10 +03:00
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HashSet
2023-05-19 07:47:12 +03:00
import Data.List.NonEmpty qualified as NEList
2023-03-30 18:52:20 +03:00
import Data.Map.Strict qualified as Map
2023-05-17 11:03:23 +03:00
import Data.Semigroup.Foldable ( Foldable1 ( .. ) )
2023-05-19 07:47:12 +03:00
import Data.Sequence qualified as Seq
2022-07-19 11:41:27 +03:00
import Data.Sequence.NonEmpty qualified as NESeq
2022-06-02 05:06:45 +03:00
import Data.Text.Extended ( toTxt , ( <<> ) , ( <>> ) )
2022-10-11 03:25:07 +03:00
import Hasura.Backends.DataConnector.API ( capabilitiesCase , errorResponseSummary , schemaCase )
2022-05-02 08:03:12 +03:00
import Hasura.Backends.DataConnector.API qualified as API
2023-05-19 07:47:12 +03:00
import Hasura.Backends.DataConnector.API.V0 ( FunctionInfo ( _fiDescription , _fiName ) )
2022-10-11 03:25:07 +03:00
import Hasura.Backends.DataConnector.API.V0.ErrorResponse ( _crDetails )
2023-05-17 11:03:23 +03:00
import Hasura.Backends.DataConnector.API.V0.Table qualified as DC ( TableType ( .. ) )
2022-10-20 06:23:37 +03:00
import Hasura.Backends.DataConnector.Adapter.Backend ( columnTypeToScalarType )
2023-04-13 04:29:15 +03:00
import Hasura.Backends.DataConnector.Adapter.ConfigTransform ( transformSourceConfig , validateConnSourceConfig )
2022-05-02 08:03:12 +03:00
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
2022-07-11 11:04:30 +03:00
import Hasura.Backends.DataConnector.Agent.Client ( AgentClientContext ( .. ) , runAgentClientT )
2022-04-14 05:06:07 +03:00
import Hasura.Backends.Postgres.SQL.Types ( PGDescription ( .. ) )
2023-02-24 15:31:04 +03:00
import Hasura.Base.Error ( Code ( .. ) , QErr ( .. ) , decodeValue , throw400 , throw400WithDetail , withPathK )
2023-05-19 07:47:12 +03:00
import Hasura.Function.Cache
( FunctionConfig ( .. ) ,
FunctionExposedAs ( FEAMutation , FEAQuery ) ,
FunctionInfo ( .. ) ,
FunctionOverloads ( FunctionOverloads ) ,
FunctionPermissionsMap ,
FunctionVolatility ( FTSTABLE , FTVOLATILE ) ,
InputArgument ( .. ) ,
TrackableFunctionInfo ( .. ) ,
TrackableInfo ( .. ) ,
TrackableTableInfo ( .. ) ,
getFuncArgNameTxt ,
)
import Hasura.Function.Common
( getFunctionAggregateGQLName ,
getFunctionArgsGQLName ,
getFunctionGQLName ,
)
2022-09-05 05:42:59 +03:00
import Hasura.Incremental qualified as Inc
2022-11-28 12:48:54 +03:00
import Hasura.Incremental.Select qualified as Inc
2022-07-11 11:04:30 +03:00
import Hasura.Logging ( Hasura , Logger )
2022-02-25 19:08:18 +03:00
import Hasura.Prelude
2023-04-26 09:48:12 +03:00
import Hasura.RQL.DDL.Relationship ( defaultBuildArrayRelationshipInfo , defaultBuildObjectRelationshipInfo )
2022-06-02 05:06:45 +03:00
import Hasura.RQL.IR.BoolExp ( OpExpG ( .. ) , PartialSQLExp ( .. ) , RootOrCurrent ( .. ) , RootOrCurrentColumn ( .. ) )
2023-05-19 07:47:12 +03:00
import Hasura.RQL.Types.Backend ( FunctionReturnType ( .. ) , functionGraphQLName )
2023-04-24 21:35:48 +03:00
import Hasura.RQL.Types.BackendType ( BackendSourceKind ( .. ) , BackendType ( .. ) )
2022-04-28 04:51:58 +03:00
import Hasura.RQL.Types.Column qualified as RQL . T . C
2023-05-19 07:47:12 +03:00
import Hasura.RQL.Types.Common ( JsonAggSelect ( JASMultipleRows , JASSingleObject ) , OID ( .. ) , SourceName , SystemDefined )
2023-04-11 04:29:05 +03:00
import Hasura.RQL.Types.CustomTypes ( GraphQLType ( .. ) )
2022-05-05 16:43:50 +03:00
import Hasura.RQL.Types.EventTrigger ( RecreateEventTriggers ( RETDoNothing ) )
2023-04-13 04:29:15 +03:00
import Hasura.RQL.Types.Metadata ( SourceMetadata ( .. ) )
2022-02-25 19:08:18 +03:00
import Hasura.RQL.Types.Metadata.Backend ( BackendMetadata ( .. ) )
2022-09-05 05:42:59 +03:00
import Hasura.RQL.Types.Metadata.Object
2023-05-19 07:47:12 +03:00
import Hasura.RQL.Types.NamingCase ( NamingCase )
import Hasura.RQL.Types.Relationships.Local ( ArrRelDef , ObjRelDef , RelInfo ( ) )
2023-05-17 11:03:23 +03:00
import Hasura.RQL.Types.SchemaCache ( CacheRM , askSourceConfig , askSourceInfo )
2022-09-05 05:42:59 +03:00
import Hasura.RQL.Types.SchemaCache.Build
2023-05-19 07:47:12 +03:00
import Hasura.RQL.Types.SchemaCacheTypes ( DependencyReason ( DRTable ) , SchemaDependency ( SchemaDependency ) , SchemaObjId ( SOSourceObj ) , SourceObjId ( SOITable ) )
2023-05-17 11:03:23 +03:00
import Hasura.RQL.Types.Source ( DBObjectsIntrospection ( .. ) , SourceInfo ( .. ) )
import Hasura.RQL.Types.Source.Column ( ColumnValueGenerationStrategy ( .. ) , SourceColumnInfo ( .. ) )
import Hasura.RQL.Types.Source.Table ( SourceConstraint ( .. ) , SourceForeignKeys ( .. ) , SourceTableInfo ( .. ) , SourceTableType ( .. ) )
2023-05-19 07:47:12 +03:00
import Hasura.RQL.Types.SourceCustomization ( applyFieldNameCaseCust )
import Hasura.SQL.AnyBackend ( mkAnyBackend )
2022-04-14 05:06:07 +03:00
import Hasura.SQL.Types ( CollectableType ( .. ) )
2022-11-02 01:41:22 +03:00
import Hasura.Server.Migrate.Version ( SourceCatalogMigrationState ( .. ) )
2022-04-28 04:51:58 +03:00
import Hasura.Server.Utils qualified as HSU
harmonize network manager handling
## Description
### I want to speak to the `Manager`
Oh boy. This PR is both fairly straightforward and overreaching, so let's break it down.
For most network access, we need a [`HTTP.Manager`](https://hackage.haskell.org/package/http-client-0.1.0.0/docs/Network-HTTP-Client-Manager.html). It is created only once, at the top level, when starting the engine, and is then threaded through the application to wherever we need to make a network call. As of main, the way we do this is not standardized: most of the GraphQL execution code passes it "manually" as a function argument throughout the code. We also have a custom monad constraint, `HasHttpManagerM`, that describes a monad's ability to provide a manager. And, finally, several parts of the code store the manager in some kind of argument structure, such as `RunT`'s `RunCtx`.
This PR's first goal is to harmonize all of this: we always create the manager at the root, and we already have it when we do our very first `runReaderT`. Wouldn't it make sense for the rest of the code to not manually pass it anywhere, to not store it anywhere, but to always rely on the current monad providing it? This is, in short, what this PR does: it implements a constraint on the base monads, so that they provide the manager, and removes most explicit passing from the code.
### First come, first served
One way this PR goes a tiny bit further than "just" doing the aforementioned harmonization is that it starts the process of implementing the "Services oriented architecture" roughly outlined in this [draft document](https://docs.google.com/document/d/1FAigqrST0juU1WcT4HIxJxe1iEBwTuBZodTaeUvsKqQ/edit?usp=sharing). Instead of using the existing `HasHTTPManagerM`, this PR revamps it into the `ProvidesNetwork` service.
The idea is, again, that we should make all "external" dependencies of the engine, all things that the core of the engine doesn't care about, a "service". This allows us to define clear APIs for features, to choose different implementations based on which version of the engine we're running, harmonizes our many scattered monadic constraints... Which is why this service is called "Network": we can refine it, moving forward, to be the constraint that defines how all network communication is to operate, instead of relying on disparate classes constraint or hardcoded decisions. A comment in the code clarifies this intent.
### Side-effects? In my Haskell?
This PR also unavoidably touches some other aspects of the codebase. One such example: it introduces `Hasura.App.AppContext`, named after `HasuraPro.Context.AppContext`: a name for the reader structure at the base level. It also transforms `Handler` from a type alias to a newtype, as `Handler` is where we actually enforce HTTP limits; but without `Handler` being a distinct type, any code path could simply do a `runExceptT $ runReader` and forget to enforce them.
(As a rule of thumb, i am starting to consider any straggling `runReaderT` or `runExceptT` as a code smell: we should not stack / unstack monads haphazardly, and every layer should be an opaque `newtype` with a corresponding run function.)
## Further work
In several places, i have left TODOs when i have encountered things that suggest that we should do further unrelated cleanups. I'll write down the follow-up steps, either in the aforementioned document or on slack. But, in short, at a glance, in approximate order, we could:
- delete `ExecutionCtx` as it is only a subset of `ServerCtx`, and remove one more `runReaderT` call
- delete `ServerConfigCtx` as it is only a subset of `ServerCtx`, and remove it from `RunCtx`
- remove `ServerCtx` from `HandlerCtx`, and make it part of `AppContext`, or even make it the `AppContext` altogether (since, at least for the OSS version, `AppContext` is there again only a subset)
- remove `CacheBuildParams` and `CacheBuild` altogether, as they're just a distinct stack that is a `ReaderT` on top of `IO` that contains, you guessed it, the same thing as `ServerCtx`
- move `RunT` out of `RQL.Types` and rename it, since after the previous cleanups **it only contains `UserInfo`**; it could be bundled with the authentication service, made a small implementation detail in `Hasura.Server.Auth`
- rename `PGMetadaStorageT` to something a bit more accurate, such as `App`, and enforce its IO base
This would significantly simply our complex stack. From there, or in parallel, we can start moving existing dependencies as Services. For the purpose of supporting read replicas entitlement, we could move `MonadResolveSource` to a `SourceResolver` service, as attempted in #7653, and transform `UserAuthenticationM` into a `Authentication` service.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7736
GitOrigin-RevId: 68cce710eb9e7d752bda1ba0c49541d24df8209f
2023-02-22 18:53:52 +03:00
import Hasura.Services.Network
2022-04-14 05:06:07 +03:00
import Hasura.Session ( SessionVariable , mkSessionVariable )
2023-05-17 11:53:31 +03:00
import Hasura.Table.Cache ( ForeignKey ( _fkConstraint ) )
import Hasura.Table.Cache qualified as RQL . T . T
2022-12-22 22:47:17 +03:00
import Hasura.Tracing ( ignoreTraceT )
2023-04-11 04:29:05 +03:00
import Language.GraphQL.Draft.Syntax qualified as G
2022-04-14 05:06:07 +03:00
import Language.GraphQL.Draft.Syntax qualified as GQL
import Network.HTTP.Client qualified as HTTP
2023-04-13 04:29:15 +03:00
import Servant.Client ( ( // ) )
2022-07-11 11:04:30 +03:00
import Servant.Client.Generic ( genericClient )
2022-04-14 05:06:07 +03:00
import Witch qualified
2022-02-25 19:08:18 +03:00
2022-05-02 08:03:12 +03:00
instance BackendMetadata 'DataConnector where
2022-11-02 01:41:22 +03:00
prepareCatalog _ = pure ( RETDoNothing , SCMSNotSupported )
2022-09-14 15:59:37 +03:00
type BackendInvalidationKeys 'DataConnector = HashMap DC . DataConnectorName Inc . InvalidationKey
2022-09-05 05:42:59 +03:00
resolveBackendInfo = resolveBackendInfo'
2022-04-14 05:06:07 +03:00
resolveSourceConfig = resolveSourceConfig'
resolveDatabaseMetadata = resolveDatabaseMetadata'
parseBoolExpOperations = parseBoolExpOperations'
parseCollectableType = parseCollectableType'
2022-05-02 08:03:12 +03:00
buildComputedFieldInfo = error " buildComputedFieldInfo: not implemented for the Data Connector backend. "
2023-05-19 07:47:12 +03:00
buildArrayRelationshipInfo = buildArrayRelationshipInfo'
buildObjectRelationshipInfo = buildObjectRelationshipInfo'
2023-01-11 05:36:03 +03:00
-- If/when we implement enums for Data Connector backend, we will also need to fix columnTypeToScalarType function
-- in Hasura.Backends.DataConnector.Adapter.Backend. See note there for more information.
2022-05-02 08:03:12 +03:00
fetchAndValidateEnumValues = error " fetchAndValidateEnumValues: not implemented for the Data Connector backend. "
2023-05-19 07:47:12 +03:00
buildFunctionInfo = buildFunctionInfo'
2022-05-02 08:03:12 +03:00
updateColumnInEventTrigger = error " updateColumnInEventTrigger: not implemented for the Data Connector backend. "
2022-07-19 14:39:44 +03:00
postDropSourceHook _sourceConfig _tableTriggerMap = pure ()
2022-05-25 13:24:41 +03:00
buildComputedFieldBooleanExp _ _ _ _ _ _ =
error " buildComputedFieldBooleanExp: not implemented for the Data Connector backend. "
2023-04-11 04:29:05 +03:00
columnInfoToFieldInfo = columnInfoToFieldInfo'
2023-04-05 23:14:35 +03:00
listAllTables = listAllTables'
2023-05-19 07:47:12 +03:00
listAllTrackables = listAllTrackables'
2023-05-17 11:03:23 +03:00
getTableInfo = getTableInfo'
2023-03-08 08:59:40 +03:00
supportsBeingRemoteRelationshipTarget = supportsBeingRemoteRelationshipTarget'
2022-04-14 05:06:07 +03:00
2023-05-19 07:47:12 +03:00
arityJsonAggSelect :: API . FunctionArity -> JsonAggSelect
arityJsonAggSelect = \ case
API . FunctionArityOne -> JASSingleObject
API . FunctionArityMany -> JASMultipleRows
functionReturnTypeFromAPI ::
MonadError QErr m =>
DC . FunctionName ->
( Maybe ( FunctionReturnType 'DataConnector ) , API . FunctionReturnType ) ->
m DC . TableName
functionReturnTypeFromAPI funcGivenName = \ case
( Just ( DC . FunctionReturnsTable t ) , _ ) -> pure t
( _ , API . FunctionReturnsTable t ) -> pure ( Witch . into t )
_ ->
throw400 NotSupported $
" Function "
<> toTxt funcGivenName
<> " is missing a return type - This should be explicit in metadata, or inferred from agent "
buildFunctionInfo' ::
MonadError QErr m =>
SourceName ->
DC . FunctionName ->
SystemDefined ->
FunctionConfig 'DataConnector ->
FunctionPermissionsMap ->
API . FunctionInfo ->
Maybe Text ->
NamingCase ->
m
( Hasura . Function . Cache . FunctionInfo 'DataConnector ,
SchemaDependency
)
buildFunctionInfo'
sourceName
funcName
sysDefined
funcConfig @ FunctionConfig { .. }
permissionMap
( API . FunctionInfo infoName infoType returnType infoSet infoArgs infoDesc )
funcComment
namingCase =
do
funcGivenName <- functionGraphQLName @ 'DataConnector funcName ` onLeft ` throwError
let ( volitility , exposeAs ) = case infoType of
API . FRead -> ( FTSTABLE , FEAQuery )
API . FWrite -> ( FTVOLATILE , FEAMutation )
setNamingCase = applyFieldNameCaseCust namingCase
objid <-
case ( _fcResponse , returnType ) of
( Just ( DC . FunctionReturnsTable t ) , _ ) -> pure $ SOSourceObj sourceName $ mkAnyBackend $ SOITable @ 'DataConnector t
( _ , API . FunctionReturnsTable t ) -> pure $ SOSourceObj sourceName $ mkAnyBackend $ SOITable @ 'DataConnector ( Witch . into t )
_ ->
throw400 NotSupported $
" Function "
<> tshow funcName
<> " is missing a return type - This should be explicit in metadata, or inferred from agent "
inputArguments <- do
let argNames = map API . _faInputArgName infoArgs
invalidArgs = filter ( isNothing . GQL . mkName ) argNames
unless ( null invalidArgs ) $ throw400 NotSupported $ " Invalid argument names: " <> tshow invalidArgs
-- Modified version of makeInputArguments from PG:
case _fcSessionArgument of
Nothing -> pure $ Seq . fromList $ map IAUserProvided infoArgs
Just sessionArgName -> do
unless ( any ( \ arg -> getFuncArgNameTxt sessionArgName == API . _faInputArgName arg ) infoArgs ) $
throw400 NotSupported $
" Session argument not mappable: " <> tshow sessionArgName
pure $
Seq . fromList $
flip map infoArgs $ \ arg ->
if getFuncArgNameTxt sessionArgName == API . _faInputArgName arg
then IASessionVariables sessionArgName
else IAUserProvided arg
functionReturnType <- functionReturnTypeFromAPI funcName ( _fcResponse , returnType )
let funcInfo =
FunctionInfo
{ _fiSQLName = Witch . into infoName , -- Converts to DC.FunctionName
_fiGQLName = getFunctionGQLName funcGivenName funcConfig setNamingCase ,
_fiGQLArgsName = getFunctionArgsGQLName funcGivenName funcConfig setNamingCase ,
_fiGQLAggregateName = getFunctionAggregateGQLName funcGivenName funcConfig setNamingCase ,
_fiSystemDefined = sysDefined ,
_fiVolatility = volitility ,
_fiExposedAs = exposeAs ,
_fiInputArgs = inputArguments ,
_fiReturnType = functionReturnType ,
_fiDescription = infoDesc ,
_fiPermissions = permissionMap ,
_fiJsonAggSelect = arityJsonAggSelect infoSet ,
_fiComment = funcComment
}
pure $ ( funcInfo , SchemaDependency objid DRTable )
2022-09-05 05:42:59 +03:00
resolveBackendInfo' ::
Rewrite `Tracing` to allow for only one `TraceT` in the entire stack.
This PR is on top of #7789.
### Description
This PR entirely rewrites the API of the Tracing library, to make `interpTraceT` a thing of the past. Before this change, we ran traces by sticking a `TraceT` on top of whatever we were doing. This had several major drawbacks:
- we were carrying a bunch of `TraceT` across the codebase, and the entire codebase had to know about it
- we needed to carry a second class constraint around (`HasReporterM`) to be able to run all of those traces
- we kept having to do stack rewriting with `interpTraceT`, which went from inconvenient to horrible
- we had to declare several behavioral instances on `TraceT m`
This PR rewrite all of `Tracing` using a more conventional model: there is ONE `TraceT` at the bottom of the stack, and there is an associated class constraint `MonadTrace`: any part of the code that happens to satisfy `MonadTrace` is able to create new traces. We NEVER have to do stack rewriting, `interpTraceT` is gone, and `TraceT` and `Reporter` become implementation details that 99% of the code is blissfully unaware of: code that needs to do tracing only needs to declare that the monad in which it operates implements `MonadTrace`.
In doing so, this PR revealed **several bugs in the codebase**: places where we were expecting to trace something, but due to the default instance of `HasReporterM IO` we would actually not do anything. This PR also splits the code of `Tracing` in more byte-sized modules, with the goal of potentially moving to `server/lib` down the line.
### Remaining work
This PR is a draft; what's left to do is:
- [x] make Pro compile; i haven't updated `HasuraPro/Main` yet
- [x] document Tracing by writing a note that explains how to use the library, and the meaning of "reporter", "trace" and "span", as well as the pitfalls
- [x] discuss some of the trade-offs in the implementation, which is why i'm opening this PR already despite it not fully building yet
- [x] it depends on #7789 being merged first
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7791
GitOrigin-RevId: cadd32d039134c93ddbf364599a2f4dd988adea8
2023-03-13 20:37:16 +03:00
forall arr m .
2022-09-05 05:42:59 +03:00
( ArrowChoice arr ,
Inc . ArrowCache m arr ,
Inc . ArrowDistribute arr ,
2022-11-15 19:58:51 +03:00
ArrowWriter ( Seq ( Either InconsistentMetadata MetadataDependency ) ) arr ,
2022-09-05 05:42:59 +03:00
MonadIO m ,
2023-01-25 06:36:52 +03:00
MonadBaseControl IO m ,
harmonize network manager handling
## Description
### I want to speak to the `Manager`
Oh boy. This PR is both fairly straightforward and overreaching, so let's break it down.
For most network access, we need a [`HTTP.Manager`](https://hackage.haskell.org/package/http-client-0.1.0.0/docs/Network-HTTP-Client-Manager.html). It is created only once, at the top level, when starting the engine, and is then threaded through the application to wherever we need to make a network call. As of main, the way we do this is not standardized: most of the GraphQL execution code passes it "manually" as a function argument throughout the code. We also have a custom monad constraint, `HasHttpManagerM`, that describes a monad's ability to provide a manager. And, finally, several parts of the code store the manager in some kind of argument structure, such as `RunT`'s `RunCtx`.
This PR's first goal is to harmonize all of this: we always create the manager at the root, and we already have it when we do our very first `runReaderT`. Wouldn't it make sense for the rest of the code to not manually pass it anywhere, to not store it anywhere, but to always rely on the current monad providing it? This is, in short, what this PR does: it implements a constraint on the base monads, so that they provide the manager, and removes most explicit passing from the code.
### First come, first served
One way this PR goes a tiny bit further than "just" doing the aforementioned harmonization is that it starts the process of implementing the "Services oriented architecture" roughly outlined in this [draft document](https://docs.google.com/document/d/1FAigqrST0juU1WcT4HIxJxe1iEBwTuBZodTaeUvsKqQ/edit?usp=sharing). Instead of using the existing `HasHTTPManagerM`, this PR revamps it into the `ProvidesNetwork` service.
The idea is, again, that we should make all "external" dependencies of the engine, all things that the core of the engine doesn't care about, a "service". This allows us to define clear APIs for features, to choose different implementations based on which version of the engine we're running, harmonizes our many scattered monadic constraints... Which is why this service is called "Network": we can refine it, moving forward, to be the constraint that defines how all network communication is to operate, instead of relying on disparate classes constraint or hardcoded decisions. A comment in the code clarifies this intent.
### Side-effects? In my Haskell?
This PR also unavoidably touches some other aspects of the codebase. One such example: it introduces `Hasura.App.AppContext`, named after `HasuraPro.Context.AppContext`: a name for the reader structure at the base level. It also transforms `Handler` from a type alias to a newtype, as `Handler` is where we actually enforce HTTP limits; but without `Handler` being a distinct type, any code path could simply do a `runExceptT $ runReader` and forget to enforce them.
(As a rule of thumb, i am starting to consider any straggling `runReaderT` or `runExceptT` as a code smell: we should not stack / unstack monads haphazardly, and every layer should be an opaque `newtype` with a corresponding run function.)
## Further work
In several places, i have left TODOs when i have encountered things that suggest that we should do further unrelated cleanups. I'll write down the follow-up steps, either in the aforementioned document or on slack. But, in short, at a glance, in approximate order, we could:
- delete `ExecutionCtx` as it is only a subset of `ServerCtx`, and remove one more `runReaderT` call
- delete `ServerConfigCtx` as it is only a subset of `ServerCtx`, and remove it from `RunCtx`
- remove `ServerCtx` from `HandlerCtx`, and make it part of `AppContext`, or even make it the `AppContext` altogether (since, at least for the OSS version, `AppContext` is there again only a subset)
- remove `CacheBuildParams` and `CacheBuild` altogether, as they're just a distinct stack that is a `ReaderT` on top of `IO` that contains, you guessed it, the same thing as `ServerCtx`
- move `RunT` out of `RQL.Types` and rename it, since after the previous cleanups **it only contains `UserInfo`**; it could be bundled with the authentication service, made a small implementation detail in `Hasura.Server.Auth`
- rename `PGMetadaStorageT` to something a bit more accurate, such as `App`, and enforce its IO base
This would significantly simply our complex stack. From there, or in parallel, we can start moving existing dependencies as Services. For the purpose of supporting read replicas entitlement, we could move `MonadResolveSource` to a `SourceResolver` service, as attempted in #7653, and transform `UserAuthenticationM` into a `Authentication` service.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7736
GitOrigin-RevId: 68cce710eb9e7d752bda1ba0c49541d24df8209f
2023-02-22 18:53:52 +03:00
ProvidesNetwork m
2022-09-05 05:42:59 +03:00
) =>
2022-09-01 08:27:57 +03:00
Logger Hasura ->
2023-03-30 18:52:20 +03:00
( Inc . Dependency ( Maybe ( HashMap DC . DataConnectorName Inc . InvalidationKey ) ) , Map . Map DC . DataConnectorName DC . DataConnectorOptions ) ` arr ` HashMap DC . DataConnectorName DC . DataConnectorInfo
2022-09-14 15:59:37 +03:00
resolveBackendInfo' logger = proc ( invalidationKeys , optionsMap ) -> do
2022-09-05 05:42:59 +03:00
maybeDataConnectorCapabilities <-
( |
Inc . keyed
( \ dataConnectorName dataConnectorOptions -> do
2022-09-14 15:59:37 +03:00
getDataConnectorCapabilitiesIfNeeded -< ( invalidationKeys , dataConnectorName , dataConnectorOptions )
2022-09-05 05:42:59 +03:00
)
2023-03-30 18:52:20 +03:00
| ) ( toHashMap optionsMap )
2022-09-05 05:42:59 +03:00
returnA -< HashMap . catMaybes maybeDataConnectorCapabilities
where
getDataConnectorCapabilitiesIfNeeded ::
2022-11-28 12:48:54 +03:00
( Inc . Dependency ( Maybe ( HashMap DC . DataConnectorName Inc . InvalidationKey ) ) , DC . DataConnectorName , DC . DataConnectorOptions ) ` arr ` Maybe DC . DataConnectorInfo
2022-09-14 15:59:37 +03:00
getDataConnectorCapabilitiesIfNeeded = Inc . cache proc ( invalidationKeys , dataConnectorName , dataConnectorOptions ) -> do
2022-09-05 05:42:59 +03:00
let metadataObj = MetadataObject ( MODataConnectorAgent dataConnectorName ) $ J . toJSON dataConnectorName
harmonize network manager handling
## Description
### I want to speak to the `Manager`
Oh boy. This PR is both fairly straightforward and overreaching, so let's break it down.
For most network access, we need a [`HTTP.Manager`](https://hackage.haskell.org/package/http-client-0.1.0.0/docs/Network-HTTP-Client-Manager.html). It is created only once, at the top level, when starting the engine, and is then threaded through the application to wherever we need to make a network call. As of main, the way we do this is not standardized: most of the GraphQL execution code passes it "manually" as a function argument throughout the code. We also have a custom monad constraint, `HasHttpManagerM`, that describes a monad's ability to provide a manager. And, finally, several parts of the code store the manager in some kind of argument structure, such as `RunT`'s `RunCtx`.
This PR's first goal is to harmonize all of this: we always create the manager at the root, and we already have it when we do our very first `runReaderT`. Wouldn't it make sense for the rest of the code to not manually pass it anywhere, to not store it anywhere, but to always rely on the current monad providing it? This is, in short, what this PR does: it implements a constraint on the base monads, so that they provide the manager, and removes most explicit passing from the code.
### First come, first served
One way this PR goes a tiny bit further than "just" doing the aforementioned harmonization is that it starts the process of implementing the "Services oriented architecture" roughly outlined in this [draft document](https://docs.google.com/document/d/1FAigqrST0juU1WcT4HIxJxe1iEBwTuBZodTaeUvsKqQ/edit?usp=sharing). Instead of using the existing `HasHTTPManagerM`, this PR revamps it into the `ProvidesNetwork` service.
The idea is, again, that we should make all "external" dependencies of the engine, all things that the core of the engine doesn't care about, a "service". This allows us to define clear APIs for features, to choose different implementations based on which version of the engine we're running, harmonizes our many scattered monadic constraints... Which is why this service is called "Network": we can refine it, moving forward, to be the constraint that defines how all network communication is to operate, instead of relying on disparate classes constraint or hardcoded decisions. A comment in the code clarifies this intent.
### Side-effects? In my Haskell?
This PR also unavoidably touches some other aspects of the codebase. One such example: it introduces `Hasura.App.AppContext`, named after `HasuraPro.Context.AppContext`: a name for the reader structure at the base level. It also transforms `Handler` from a type alias to a newtype, as `Handler` is where we actually enforce HTTP limits; but without `Handler` being a distinct type, any code path could simply do a `runExceptT $ runReader` and forget to enforce them.
(As a rule of thumb, i am starting to consider any straggling `runReaderT` or `runExceptT` as a code smell: we should not stack / unstack monads haphazardly, and every layer should be an opaque `newtype` with a corresponding run function.)
## Further work
In several places, i have left TODOs when i have encountered things that suggest that we should do further unrelated cleanups. I'll write down the follow-up steps, either in the aforementioned document or on slack. But, in short, at a glance, in approximate order, we could:
- delete `ExecutionCtx` as it is only a subset of `ServerCtx`, and remove one more `runReaderT` call
- delete `ServerConfigCtx` as it is only a subset of `ServerCtx`, and remove it from `RunCtx`
- remove `ServerCtx` from `HandlerCtx`, and make it part of `AppContext`, or even make it the `AppContext` altogether (since, at least for the OSS version, `AppContext` is there again only a subset)
- remove `CacheBuildParams` and `CacheBuild` altogether, as they're just a distinct stack that is a `ReaderT` on top of `IO` that contains, you guessed it, the same thing as `ServerCtx`
- move `RunT` out of `RQL.Types` and rename it, since after the previous cleanups **it only contains `UserInfo`**; it could be bundled with the authentication service, made a small implementation detail in `Hasura.Server.Auth`
- rename `PGMetadaStorageT` to something a bit more accurate, such as `App`, and enforce its IO base
This would significantly simply our complex stack. From there, or in parallel, we can start moving existing dependencies as Services. For the purpose of supporting read replicas entitlement, we could move `MonadResolveSource` to a `SourceResolver` service, as attempted in #7653, and transform `UserAuthenticationM` into a `Authentication` service.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7736
GitOrigin-RevId: 68cce710eb9e7d752bda1ba0c49541d24df8209f
2023-02-22 18:53:52 +03:00
httpMgr <- bindA -< askHTTPManager
2022-11-28 12:48:54 +03:00
Inc . dependOn -< Inc . selectMaybeD ( Inc . ConstS dataConnectorName ) invalidationKeys
2022-09-05 05:42:59 +03:00
( |
withRecordInconsistency
2023-04-12 18:49:55 +03:00
( bindErrorA -< ExceptT $ getDataConnectorCapabilities dataConnectorOptions httpMgr
2022-09-05 05:42:59 +03:00
)
| ) metadataObj
getDataConnectorCapabilities ::
DC . DataConnectorOptions ->
HTTP . Manager ->
m ( Either QErr DC . DataConnectorInfo )
getDataConnectorCapabilities options @ DC . DataConnectorOptions { .. } manager = runExceptT do
2022-10-11 03:25:07 +03:00
capabilitiesU <-
2022-12-22 22:47:17 +03:00
ignoreTraceT
2023-04-05 11:57:19 +03:00
. flip runAgentClientT ( AgentClientContext logger _dcoUri manager Nothing Nothing )
2023-02-07 05:55:22 +03:00
$ genericClient @ API . Routes // API . _capabilities
2022-10-11 03:25:07 +03:00
let defaultAction = throw400 DataConnectorError " Unexpected data connector capabilities response - Unexpected Type "
2022-11-18 07:17:50 +03:00
capabilitiesAction API . CapabilitiesResponse { .. } = pure $ DC . DataConnectorInfo options _crCapabilities _crConfigSchemaResponse _crDisplayName _crReleaseName
2022-10-11 03:25:07 +03:00
capabilitiesCase defaultAction capabilitiesAction errorAction capabilitiesU
2022-09-01 08:27:57 +03:00
2023-03-30 18:52:20 +03:00
toHashMap = HashMap . fromList . Map . toList
2022-04-14 05:06:07 +03:00
resolveSourceConfig' ::
2023-04-13 04:29:15 +03:00
( Monad m ) =>
2022-04-14 05:06:07 +03:00
SourceName ->
2022-05-02 08:03:12 +03:00
DC . ConnSourceConfig ->
BackendSourceKind 'DataConnector ->
2022-09-05 05:42:59 +03:00
HashMap DC . DataConnectorName DC . DataConnectorInfo ->
2022-04-14 05:06:07 +03:00
Environment ->
2022-07-27 10:18:36 +03:00
HTTP . Manager ->
2022-05-02 08:03:12 +03:00
m ( Either QErr DC . SourceConfig )
2022-09-01 08:27:57 +03:00
resolveSourceConfig'
sourceName
2022-09-14 15:59:37 +03:00
csc @ DC . ConnSourceConfig { template , timeout , value = originalConfig }
2022-09-01 08:27:57 +03:00
( DataConnectorKind dataConnectorName )
2022-09-05 05:42:59 +03:00
backendInfo
2022-09-01 08:27:57 +03:00
env
manager = runExceptT do
2023-04-13 04:29:15 +03:00
DC . DataConnectorInfo { _dciOptions = DC . DataConnectorOptions { _dcoUri } , .. } <- getDataConnectorInfo dataConnectorName backendInfo
2022-07-11 11:04:30 +03:00
2023-04-13 04:29:15 +03:00
validateConnSourceConfig dataConnectorName sourceName _dciConfigSchemaResponse csc Nothing env
2022-10-11 03:25:07 +03:00
2022-09-01 08:27:57 +03:00
pure
DC . SourceConfig
{ _scEndpoint = _dcoUri ,
_scConfig = originalConfig ,
_scTemplate = template ,
2022-09-05 05:42:59 +03:00
_scCapabilities = _dciCapabilities ,
2022-09-01 08:27:57 +03:00
_scManager = manager ,
_scTimeoutMicroseconds = ( DC . sourceTimeoutMicroseconds <$> timeout ) ,
2023-04-13 04:29:15 +03:00
_scDataConnectorName = dataConnectorName ,
_scEnvironment = env
2022-09-01 08:27:57 +03:00
}
2022-04-14 05:06:07 +03:00
2022-12-02 11:01:06 +03:00
getDataConnectorInfo :: ( MonadError QErr m ) => DC . DataConnectorName -> HashMap DC . DataConnectorName DC . DataConnectorInfo -> m DC . DataConnectorInfo
getDataConnectorInfo dataConnectorName backendInfo =
2023-03-30 18:52:20 +03:00
onNothing ( HashMap . lookup dataConnectorName backendInfo ) $
2022-12-02 11:01:06 +03:00
throw400 DataConnectorError ( " Data connector named " <> toTxt dataConnectorName <<> " was not found in the data connector backend info " )
2022-05-05 08:18:43 +03:00
2022-04-14 05:06:07 +03:00
resolveDatabaseMetadata' ::
2023-04-13 04:29:15 +03:00
( MonadIO m ,
MonadBaseControl IO m
) =>
Logger Hasura ->
2022-05-02 08:03:12 +03:00
SourceMetadata 'DataConnector ->
DC . SourceConfig ->
2023-01-20 17:51:11 +03:00
m ( Either QErr ( DBObjectsIntrospection 'DataConnector ) )
2023-04-13 04:29:15 +03:00
resolveDatabaseMetadata' logger SourceMetadata { _smName } sourceConfig @ DC . SourceConfig { _scCapabilities } = runExceptT do
API . SchemaResponse { .. } <- requestDatabaseSchema logger _smName sourceConfig
2023-04-11 04:29:05 +03:00
let typeNames = maybe mempty ( HashSet . fromList . toList . fmap API . _otdName ) _srObjectTypes
customObjectTypes =
maybe mempty ( HashMap . fromList . mapMaybe ( toTableObjectType _scCapabilities typeNames ) . toList ) _srObjectTypes
tables = HashMap . fromList $ do
2022-09-21 08:11:53 +03:00
API . TableInfo { .. } <- _srTables
2023-04-05 05:21:43 +03:00
let primaryKeyColumns = fmap Witch . from . NESeq . fromList <$> _tiPrimaryKey
2022-04-14 05:06:07 +03:00
let meta =
2022-04-28 04:51:58 +03:00
RQL . T . T . DBTableMetadata
2022-12-08 05:05:28 +03:00
{ _ptmiOid = OID 0 , -- TODO: This is wrong and needs to be fixed. It is used for diffing tables and seeing what's new/deleted/altered, so reusing 0 for all tables is problematic.
2022-04-14 05:06:07 +03:00
_ptmiColumns = do
2022-09-21 08:11:53 +03:00
API . ColumnInfo { .. } <- _tiColumns
2022-04-14 05:06:07 +03:00
pure $
2022-04-28 04:51:58 +03:00
RQL . T . C . RawColumnInfo
2022-09-21 08:11:53 +03:00
{ rciName = Witch . from _ciName ,
2022-12-08 05:05:28 +03:00
rciPosition = 1 , -- TODO: This is very wrong and needs to be fixed. It is used for diffing tables and seeing what's new/deleted/altered, so reusing 1 for all columns is problematic.
2022-12-01 03:07:16 +03:00
rciType = DC . mkScalarType _scCapabilities _ciType ,
2022-09-21 08:11:53 +03:00
rciIsNullable = _ciNullable ,
rciDescription = fmap GQL . Description _ciDescription ,
2022-12-08 05:05:28 +03:00
rciMutability = RQL . T . C . ColumnMutability _ciInsertable _ciUpdatable
2022-04-14 05:06:07 +03:00
} ,
2023-04-05 05:21:43 +03:00
_ptmiPrimaryKey = RQL . T . T . PrimaryKey ( RQL . T . T . Constraint ( DC . ConstraintName " " ) ( OID 0 ) ) <$> primaryKeyColumns ,
2022-04-14 05:06:07 +03:00
_ptmiUniqueConstraints = mempty ,
2023-02-02 14:36:06 +03:00
_ptmiForeignKeys = buildForeignKeySet _tiForeignKeys ,
2022-12-08 05:05:28 +03:00
_ptmiViewInfo =
( if _tiType == API . Table && _tiInsertable && _tiUpdatable && _tiDeletable
then Nothing
else Just $ RQL . T . T . ViewInfo _tiInsertable _tiUpdatable _tiDeletable
) ,
2022-09-21 08:11:53 +03:00
_ptmiDescription = fmap PGDescription _tiDescription ,
2023-04-05 05:21:43 +03:00
_ptmiExtraTableMetadata =
DC . ExtraTableMetadata
2023-04-18 08:36:02 +03:00
{ _etmTableType = _tiType ,
_etmExtraColumnMetadata =
2023-04-05 05:21:43 +03:00
_tiColumns
& fmap ( \ API . ColumnInfo { .. } -> ( Witch . from _ciName , DC . ExtraColumnMetadata _ciValueGenerated ) )
& HashMap . fromList
2023-04-11 04:29:05 +03:00
} ,
_ptmiCustomObjectTypes = Just customObjectTypes
2022-04-14 05:06:07 +03:00
}
2023-05-19 07:47:12 +03:00
pure ( Witch . into _tiName , meta )
functions =
let sorted = sortOn _fiName _srFunctions
grouped = NEList . groupBy ( ( == ) ` on ` _fiName ) sorted
in HashMap . fromList do
infos @ ( API . FunctionInfo { .. } NEList .:| _ ) <- grouped
pure ( Witch . into _fiName , FunctionOverloads infos )
2022-04-14 05:06:07 +03:00
in pure $
2023-04-13 04:29:15 +03:00
DBObjectsIntrospection
{ _rsTables = tables ,
2023-05-19 07:47:12 +03:00
_rsFunctions = functions ,
2023-04-13 04:29:15 +03:00
_rsScalars = mempty
}
requestDatabaseSchema ::
( MonadIO m , MonadBaseControl IO m , MonadError QErr m ) =>
Logger Hasura ->
SourceName ->
DC . SourceConfig ->
m API . SchemaResponse
requestDatabaseSchema logger sourceName sourceConfig = do
transformedSourceConfig <- transformSourceConfig sourceConfig Nothing
schemaResponseU <-
ignoreTraceT
. flip runAgentClientT ( AgentClientContext logger ( DC . _scEndpoint transformedSourceConfig ) ( DC . _scManager transformedSourceConfig ) ( DC . _scTimeoutMicroseconds transformedSourceConfig ) Nothing )
$ ( genericClient // API . _schema ) ( toTxt sourceName ) ( DC . _scConfig transformedSourceConfig )
let defaultAction = throw400 DataConnectorError " Unexpected data connector schema response - Unexpected Type "
schemaCase defaultAction pure errorAction schemaResponseU
2022-04-14 05:06:07 +03:00
2023-04-11 04:29:05 +03:00
toTableObjectType :: API . Capabilities -> HashSet G . Name -> API . ObjectTypeDefinition -> Maybe ( G . Name , RQL . T . T . TableObjectType 'DataConnector )
toTableObjectType capabilities typeNames API . ObjectTypeDefinition { .. } =
( _otdName , ) . RQL . T . T . TableObjectType _otdName ( G . Description <$> _otdDescription ) <$> traverse toTableObjectFieldDefinition _otdColumns
where
toTableObjectFieldDefinition API . ColumnInfo { .. } = do
fieldTypeName <- G . mkName $ API . getScalarType _ciType
fieldName <- G . mkName $ API . unColumnName _ciName
pure $
RQL . T . T . TableObjectFieldDefinition
{ _tofdColumn = Witch . from _ciName ,
_tofdName = fieldName ,
_tofdDescription = G . Description <$> _ciDescription ,
_tofdGType = GraphQLType $ G . TypeNamed ( G . Nullability _ciNullable ) fieldTypeName ,
_tofdFieldType =
if HashSet . member fieldTypeName typeNames
then RQL . T . T . TOFTObject fieldTypeName
else RQL . T . T . TOFTScalar fieldTypeName $ DC . mkScalarType capabilities _ciType
}
2022-08-24 00:46:10 +03:00
-- | Construct a 'HashSet' 'RQL.T.T.ForeignKeyMetadata'
-- 'DataConnector' to build the foreign key constraints in the table
-- metadata.
2023-02-02 14:36:06 +03:00
buildForeignKeySet :: API . ForeignKeys -> HashSet ( RQL . T . T . ForeignKeyMetadata 'DataConnector )
buildForeignKeySet ( API . ForeignKeys constraints ) =
2022-08-24 00:46:10 +03:00
HashSet . fromList $
2023-02-02 14:36:06 +03:00
constraints & HashMap . foldMapWithKey @ [ RQL . T . T . ForeignKeyMetadata 'DataConnector ]
\ constraintName API . Constraint { .. } -> maybeToList do
let columnMapAssocList = HashMap . foldrWithKey' ( \ ( API . ColumnName k ) ( API . ColumnName v ) acc -> ( DC . ColumnName k , DC . ColumnName v ) : acc ) [] _cColumnMapping
columnMapping <- NEHashMap . fromList columnMapAssocList
let foreignKey =
RQL . T . T . ForeignKey
{ _fkConstraint = RQL . T . T . Constraint ( Witch . from constraintName ) ( OID 1 ) ,
_fkForeignTable = Witch . from _cForeignTable ,
_fkColumnMapping = columnMapping
}
pure $ RQL . T . T . ForeignKeyMetadata foreignKey
2022-08-24 00:46:10 +03:00
2022-04-14 05:06:07 +03:00
-- | This is needed to get permissions to work
parseBoolExpOperations' ::
forall m v .
2023-02-24 15:31:04 +03:00
( MonadError QErr m ) =>
2022-05-02 08:03:12 +03:00
RQL . T . C . ValueParser 'DataConnector m v ->
2023-02-24 15:31:04 +03:00
RQL . T . T . FieldInfoMap ( RQL . T . T . FieldInfo 'DataConnector ) ->
2022-05-02 08:03:12 +03:00
RQL . T . T . FieldInfoMap ( RQL . T . T . FieldInfo 'DataConnector ) ->
RQL . T . C . ColumnReference 'DataConnector ->
2022-04-14 05:06:07 +03:00
J . Value ->
2022-05-02 08:03:12 +03:00
m [ OpExpG 'DataConnector v ]
2023-02-24 15:31:04 +03:00
parseBoolExpOperations' rhsParser rootFieldInfoMap fieldInfoMap columnRef value =
2022-06-02 05:06:45 +03:00
withPathK ( toTxt columnRef ) $ parseOperations value
2022-04-14 05:06:07 +03:00
where
2022-06-02 05:06:45 +03:00
columnType :: RQL . T . C . ColumnType 'DataConnector
columnType = RQL . T . C . columnReferenceType columnRef
2022-04-14 05:06:07 +03:00
parseWithTy ty = rhsParser ( CollectableTypeScalar ty )
2022-06-02 05:06:45 +03:00
parseOperations :: J . Value -> m [ OpExpG 'DataConnector v ]
parseOperations = \ case
2022-06-08 18:31:28 +03:00
J . Object o -> traverse ( parseOperation . first K . toText ) $ KM . toList o
2022-04-14 05:06:07 +03:00
v -> pure . AEQ False <$> parseWithTy columnType v
2022-06-02 05:06:45 +03:00
parseOperation :: ( Text , J . Value ) -> m ( OpExpG 'DataConnector v )
parseOperation ( opStr , val ) = withPathK opStr $
2022-04-14 05:06:07 +03:00
case opStr of
" _eq " -> parseEq
" $eq " -> parseEq
" _neq " -> parseNeq
" $neq " -> parseNeq
" _gt " -> parseGt
" $gt " -> parseGt
" _lt " -> parseLt
" $lt " -> parseLt
" _gte " -> parseGte
" $gte " -> parseGte
" _lte " -> parseLte
" $lte " -> parseLte
2022-04-28 04:51:58 +03:00
" _in " -> parseIn
2022-06-02 05:06:45 +03:00
" $in " -> parseIn
2022-04-28 04:51:58 +03:00
" _nin " -> parseNin
2022-06-02 05:06:45 +03:00
" $nin " -> parseNin
" _is_null " -> parseIsNull
" $is_null " -> parseIsNull
" _ceq " -> parseCeq
" $ceq " -> parseCeq
" _cneq " -> parseCne
" $cneq " -> parseCne
" _cgt " -> parseCgt
" $cgt " -> parseCgt
" _clt " -> parseClt
" $clt " -> parseClt
" _cgte " -> parseCgte
" $cgte " -> parseCgte
" _clte " -> parseClte
" $clte " -> parseClte
2022-04-14 05:06:07 +03:00
-- "_like" -> parseLike
2022-06-02 05:06:45 +03:00
-- "$like" -> parseLike
2022-04-14 05:06:07 +03:00
--
-- "_nlike" -> parseNlike
2022-06-02 05:06:45 +03:00
-- "$nlike" -> parseNlike
--
-- "_cast" -> parseCast
-- "$cast" -> parseCast
2022-04-14 05:06:07 +03:00
2022-10-01 17:47:12 +03:00
x -> throw400 UnexpectedPayload $ " Unknown operator: " <> x
2022-04-14 05:06:07 +03:00
where
parseOne = parseWithTy columnType val
2022-04-28 04:51:58 +03:00
parseManyWithType ty = rhsParser ( CollectableTypeArray ty ) val
2022-04-14 05:06:07 +03:00
parseEq = AEQ False <$> parseOne
parseNeq = ANE False <$> parseOne
2022-06-02 05:06:45 +03:00
parseIn = AIN <$> parseManyWithType columnType
parseNin = ANIN <$> parseManyWithType columnType
2022-04-14 05:06:07 +03:00
parseGt = AGT <$> parseOne
parseLt = ALT <$> parseOne
parseGte = AGTE <$> parseOne
parseLte = ALTE <$> parseOne
2022-06-02 05:06:45 +03:00
parseIsNull = bool ANISNOTNULL ANISNULL <$> decodeValue val
parseCeq = CEQ <$> decodeAndValidateRhsCol val
parseCne = CNE <$> decodeAndValidateRhsCol val
parseCgt = CGT <$> decodeAndValidateRhsCol val
parseClt = CLT <$> decodeAndValidateRhsCol val
parseCgte = CGTE <$> decodeAndValidateRhsCol val
parseClte = CLTE <$> decodeAndValidateRhsCol val
decodeAndValidateRhsCol :: J . Value -> m ( RootOrCurrentColumn 'DataConnector )
decodeAndValidateRhsCol v = case v of
J . String _ -> go IsCurrent fieldInfoMap v
J . Array path -> case toList path of
[] -> throw400 Unexpected " path cannot be empty "
[ col ] -> go IsCurrent fieldInfoMap col
2023-02-24 15:31:04 +03:00
[ J . String " $ " , col ] -> go IsRoot rootFieldInfoMap col
2022-06-02 05:06:45 +03:00
_ -> throw400 NotSupported " Relationship references are not supported in column comparison RHS "
_ -> throw400 Unexpected " a boolean expression JSON must be either a string or an array "
where
go rootInfo fieldInfoMap' columnValue = do
colName <- decodeValue columnValue
colInfo <- validateRhsColumn fieldInfoMap' colName
pure $ RootOrCurrentColumn rootInfo colInfo
2022-09-20 09:18:46 +03:00
validateRhsColumn :: RQL . T . T . FieldInfoMap ( RQL . T . T . FieldInfo 'DataConnector ) -> DC . ColumnName -> m DC . ColumnName
2022-06-02 05:06:45 +03:00
validateRhsColumn fieldInfoMap' rhsCol = do
rhsType <- RQL . T . T . askColumnType fieldInfoMap' rhsCol " column operators can only compare table columns "
when ( columnType /= rhsType ) $
throw400 UnexpectedPayload $
" incompatible column types: "
<> columnRef <<> " has type "
<> columnType <<> " , but "
<> rhsCol <<> " has type " <>> rhsType
pure rhsCol
2022-04-14 05:06:07 +03:00
parseCollectableType' ::
2023-05-17 11:53:31 +03:00
( MonadError QErr m ) =>
2022-05-02 08:03:12 +03:00
CollectableType ( RQL . T . C . ColumnType 'DataConnector ) ->
2022-04-14 05:06:07 +03:00
J . Value ->
2022-05-02 08:03:12 +03:00
m ( PartialSQLExp 'DataConnector )
2022-04-14 05:06:07 +03:00
parseCollectableType' collectableType = \ case
J . String t
2022-04-28 04:51:58 +03:00
| HSU . isSessionVariable t -> pure $ mkTypedSessionVar collectableType $ mkSessionVariable t
| HSU . isReqUserId t -> pure $ mkTypedSessionVar collectableType HSU . userIdHeader
2022-04-14 05:06:07 +03:00
val -> case collectableType of
2022-10-20 06:23:37 +03:00
CollectableTypeScalar columnType ->
PSESQLExp . DC . ValueLiteral ( columnTypeToScalarType columnType ) <$> RQL . T . C . parseScalarValueColumnType columnType val
2022-04-14 05:06:07 +03:00
CollectableTypeArray _ ->
2022-05-02 08:03:12 +03:00
throw400 NotSupported " Array types are not supported by the Data Connector backend "
2022-04-14 05:06:07 +03:00
mkTypedSessionVar ::
2022-05-02 08:03:12 +03:00
CollectableType ( RQL . T . C . ColumnType 'DataConnector ) ->
2022-04-14 05:06:07 +03:00
SessionVariable ->
2022-05-02 08:03:12 +03:00
PartialSQLExp 'DataConnector
2022-04-14 05:06:07 +03:00
mkTypedSessionVar columnType =
PSESessVar ( columnTypeToScalarType <$> columnType )
2023-05-17 11:53:31 +03:00
errorAction :: ( MonadError QErr m ) => API . ErrorResponse -> m a
2022-10-11 03:25:07 +03:00
errorAction e = throw400WithDetail DataConnectorError ( errorResponseSummary e ) ( _crDetails e )
2023-03-08 08:59:40 +03:00
2023-04-11 04:29:05 +03:00
-- | This function assumes that if a type name is present in the custom object types for the table then it
-- refers to a nested object of that type.
-- Otherwise it is a normal (scalar) column.
columnInfoToFieldInfo' :: HashMap G . Name ( RQL . T . T . TableObjectType 'DataConnector ) -> RQL . T . C . ColumnInfo 'DataConnector -> RQL . T . T . FieldInfo 'DataConnector
columnInfoToFieldInfo' gqlTypes columnInfo @ RQL . T . C . ColumnInfo { .. } =
maybe ( RQL . T . T . FIColumn columnInfo ) RQL . T . T . FINestedObject getNestedObjectInfo
where
getNestedObjectInfo =
case ciType of
RQL . T . C . ColumnScalar ( DC . ScalarType scalarTypeName _ ) -> do
gqlName <- GQL . mkName scalarTypeName
guard $ HashMap . member gqlName gqlTypes
pure $
RQL . T . C . NestedObjectInfo
{ RQL . T . C . _noiSupportsNestedObjects = () ,
RQL . T . C . _noiColumn = ciColumn ,
RQL . T . C . _noiName = ciName ,
RQL . T . C . _noiType = gqlName ,
RQL . T . C . _noiIsNullable = ciIsNullable ,
RQL . T . C . _noiDescription = ciDescription ,
RQL . T . C . _noiMutability = ciMutability
}
RQL . T . C . ColumnEnumReference { } -> Nothing
2023-04-26 09:48:12 +03:00
buildObjectRelationshipInfo' ::
( MonadError QErr m ) =>
DC . SourceConfig ->
SourceName ->
HashMap DC . TableName ( HashSet ( ForeignKey 'DataConnector ) ) ->
DC . TableName ->
ObjRelDef 'DataConnector ->
m ( RelInfo 'DataConnector , Seq SchemaDependency )
buildObjectRelationshipInfo' sourceConfig sourceName fks tableName objRel = do
ifSupportsLocalRelationships sourceName sourceConfig $
defaultBuildObjectRelationshipInfo sourceName fks tableName objRel
buildArrayRelationshipInfo' ::
( MonadError QErr m ) =>
DC . SourceConfig ->
SourceName ->
HashMap DC . TableName ( HashSet ( ForeignKey 'DataConnector ) ) ->
DC . TableName ->
ArrRelDef 'DataConnector ->
m ( RelInfo 'DataConnector , Seq SchemaDependency )
buildArrayRelationshipInfo' sourceConfig sourceName fks tableName arrRel =
ifSupportsLocalRelationships sourceName sourceConfig $
defaultBuildArrayRelationshipInfo sourceName fks tableName arrRel
2023-05-17 11:53:31 +03:00
ifSupportsLocalRelationships :: ( MonadError QErr m ) => SourceName -> DC . SourceConfig -> m a -> m a
2023-04-26 09:48:12 +03:00
ifSupportsLocalRelationships sourceName DC . SourceConfig { .. } action = do
let supportsRelationships = isJust $ API . _cRelationships _scCapabilities
let supportsRemoteRelationships = isJust $ API . _qcForeach =<< API . _cQueries _scCapabilities
if supportsRelationships
then action
else
let suggestion =
if supportsRemoteRelationships
then " Instead consider using remote relationships to join between tables on the same source. "
else " "
in throw400 NotSupported $ " Local object and array relationships are not supported for ' " <> toTxt sourceName <> " '. " <> suggestion
2023-03-08 08:59:40 +03:00
supportsBeingRemoteRelationshipTarget' :: DC . SourceConfig -> Bool
supportsBeingRemoteRelationshipTarget' DC . SourceConfig { .. } =
isJust $ API . _qcForeach =<< API . _cQueries _scCapabilities
2023-04-05 23:14:35 +03:00
2023-04-13 04:29:15 +03:00
listAllTables' :: ( CacheRM m , Has ( Logger Hasura ) r , MonadIO m , MonadBaseControl IO m , MonadReader r m , MonadError QErr m , MetadataM m ) => SourceName -> m [ DC . TableName ]
listAllTables' sourceName = do
( logger :: Logger Hasura ) <- asks getter
sourceConfig <- askSourceConfig @ 'DataConnector sourceName
schemaResponse <- requestDatabaseSchema logger sourceName sourceConfig
pure $ fmap ( Witch . from . API . _tiName ) $ API . _srTables schemaResponse
2023-05-17 11:03:23 +03:00
2023-05-19 07:47:12 +03:00
listAllTrackables' :: ( CacheRM m , Has ( Logger Hasura ) r , MonadIO m , MonadBaseControl IO m , MonadReader r m , MonadError QErr m , MetadataM m ) => SourceName -> m ( TrackableInfo 'DataConnector )
listAllTrackables' sourceName = do
( logger :: Logger Hasura ) <- asks getter
sourceConfig <- askSourceConfig @ 'DataConnector sourceName
schemaResponse <- requestDatabaseSchema logger sourceName sourceConfig
let functions = fmap ( \ fi -> TrackableFunctionInfo ( Witch . into ( API . _fiName fi ) ) ( getVolatility ( API . _fiFunctionType fi ) ) ) $ API . _srFunctions schemaResponse
let tables = fmap ( TrackableTableInfo . Witch . into . API . _tiName ) $ API . _srTables schemaResponse
pure
TrackableInfo
{ trackableTables = tables ,
trackableFunctions = functions
}
getVolatility :: API . FunctionType -> FunctionVolatility
getVolatility API . FRead = FTSTABLE
getVolatility API . FWrite = FTVOLATILE
2023-05-17 11:03:23 +03:00
getTableInfo' :: ( CacheRM m , MetadataM m , MonadError QErr m ) => SourceName -> DC . TableName -> m ( Maybe ( SourceTableInfo 'DataConnector ) )
getTableInfo' sourceName tableName = do
SourceInfo { _siDbObjectsIntrospection } <- askSourceInfo @ 'DataConnector sourceName
let tables :: HashMap DC . TableName ( RQL . T . T . DBTableMetadata 'DataConnector )
tables = _rsTables _siDbObjectsIntrospection
pure $ fmap ( convertTableMetadataToTableInfo tableName ) ( HashMap . lookup tableName tables )
convertTableMetadataToTableInfo :: DC . TableName -> RQL . T . T . DBTableMetadata 'DataConnector -> SourceTableInfo 'DataConnector
convertTableMetadataToTableInfo tableName RQL . T . T . DBTableMetadata { .. } =
SourceTableInfo
{ _stiName = Witch . from tableName ,
_stiType = case DC . _etmTableType _ptmiExtraTableMetadata of
DC . Table -> Table
DC . View -> View ,
_stiColumns = convertColumn <$> _ptmiColumns ,
_stiPrimaryKey = fmap Witch . from . toNonEmpty . RQL . T . T . _pkColumns <$> _ptmiPrimaryKey ,
_stiForeignKeys = convertForeignKeys _ptmiForeignKeys ,
_stiDescription = getPGDescription <$> _ptmiDescription ,
_stiInsertable = all RQL . T . T . viIsInsertable _ptmiViewInfo ,
_stiUpdatable = all RQL . T . T . viIsUpdatable _ptmiViewInfo ,
_stiDeletable = all RQL . T . T . viIsDeletable _ptmiViewInfo
}
where
convertColumn :: RQL . T . C . RawColumnInfo 'DataConnector -> SourceColumnInfo 'DataConnector
convertColumn RQL . T . C . RawColumnInfo { .. } =
SourceColumnInfo
{ _sciName = Witch . from rciName ,
_sciType = Witch . from rciType ,
_sciNullable = rciIsNullable ,
_sciDescription = G . unDescription <$> rciDescription ,
_sciInsertable = RQL . T . C . _cmIsInsertable rciMutability ,
_sciUpdatable = RQL . T . C . _cmIsUpdatable rciMutability ,
_sciValueGenerated =
extraColumnMetadata
>>= DC . _ecmValueGenerated
>>= pure . \ case
API . AutoIncrement -> AutoIncrement
API . UniqueIdentifier -> UniqueIdentifier
API . DefaultValue -> DefaultValue
}
where
extraColumnMetadata = HashMap . lookup rciName . DC . _etmExtraColumnMetadata $ _ptmiExtraTableMetadata
convertForeignKeys :: HashSet ( RQL . T . T . ForeignKeyMetadata 'DataConnector ) -> SourceForeignKeys 'DataConnector
convertForeignKeys foreignKeys =
foreignKeys
& HashSet . toList
& fmap
( \ ( RQL . T . T . ForeignKeyMetadata RQL . T . T . ForeignKey { .. } ) ->
let constraintName = RQL . T . T . _cName _fkConstraint
constraint =
SourceConstraint
{ _scForeignTable = Witch . from _fkForeignTable ,
_scColumnMapping = HashMap . fromList $ bimap Witch . from Witch . from <$> NEHashMap . toList _fkColumnMapping
}
in ( constraintName , constraint )
)
& HashMap . fromList
& SourceForeignKeys