mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
8a77386fcf
### Description This PR adds the required IR for DB to DB joins, based on @paf31 and @0x777 's `feature/db-to-db` branch. To do so, it also refactors the IR to introduce a new type parameter, `r`, which is used to recursively constructs the `v` parameter of remote QueryDBs. When collecting remote joins, we replace `r` with `Const Void`, indicating at the type level that there cannot be any leftover remote join. Furthermore, this PR refactors IR.Select for readability, moves some code from IR.Root to IR.Select to avoid having to deal with circular dependencies, and makes it compile by adding `error` in all new cases in the execution pipeline. The diff doesn't make it clear, but most of Select.hs is actually unchanged. Declarations have just been reordered by topic, in the following order: - type declarations - instance declarations - type aliases - constructor functions - traverse functions https://github.com/hasura/graphql-engine-mono/pull/1580 Co-authored-by: Phil Freeman <630306+paf31@users.noreply.github.com> GitOrigin-RevId: bbdcb4119cec8bb3fc32f1294f91b8dea0728721
140 lines
5.3 KiB
Haskell
140 lines
5.3 KiB
Haskell
module Hasura.GraphQL.Schema.Common where
|
||
|
||
import Hasura.Prelude
|
||
|
||
import qualified Data.Aeson as J
|
||
import qualified Data.HashMap.Strict as Map
|
||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||
import qualified Data.Text as T
|
||
|
||
import Data.Either (isRight)
|
||
import Data.Text.Extended
|
||
import Language.GraphQL.Draft.Syntax as G
|
||
|
||
import qualified Hasura.Backends.Postgres.SQL.Types as PG
|
||
import qualified Hasura.GraphQL.Execute.Types as ET (GraphQLQueryType)
|
||
import qualified Hasura.GraphQL.Parser as P
|
||
import qualified Hasura.RQL.IR.Select as IR
|
||
|
||
import Hasura.Base.Error
|
||
import Hasura.GraphQL.Parser (UnpreparedValue)
|
||
import Hasura.RQL.Types
|
||
|
||
|
||
type SelectExp b = IR.AnnSimpleSelG b UnpreparedValue (UnpreparedValue b)
|
||
type AggSelectExp b = IR.AnnAggregateSelectG b UnpreparedValue (UnpreparedValue b)
|
||
type ConnectionSelectExp b = IR.ConnectionSelect b UnpreparedValue (UnpreparedValue b)
|
||
type SelectArgs b = IR.SelectArgsG b (UnpreparedValue b)
|
||
type TablePerms b = IR.TablePermG b (UnpreparedValue b)
|
||
type AnnotatedFields b = IR.AnnFieldsG b UnpreparedValue (UnpreparedValue b)
|
||
type AnnotatedField b = IR.AnnFieldG b UnpreparedValue (UnpreparedValue b)
|
||
|
||
data QueryContext =
|
||
QueryContext
|
||
{ qcStringifyNum :: !Bool
|
||
, qcDangerousBooleanCollapse :: !Bool
|
||
, qcQueryType :: !ET.GraphQLQueryType
|
||
, qcRemoteRelationshipContext :: !(HashMap RemoteSchemaName (IntrospectionResult, ParsedIntrospection))
|
||
, qcFunctionPermsContext :: !FunctionPermissionsCtx
|
||
}
|
||
|
||
textToName :: MonadError QErr m => Text -> m G.Name
|
||
textToName textName = G.mkName textName `onNothing` throw400 ValidationFailed
|
||
("cannot include " <> textName <<> " in the GraphQL schema because "
|
||
<> " it is not a valid GraphQL identifier")
|
||
|
||
partialSQLExpToUnpreparedValue :: PartialSQLExp b -> P.UnpreparedValue b
|
||
partialSQLExpToUnpreparedValue (PSESessVar pftype var) = P.UVSessionVar pftype var
|
||
partialSQLExpToUnpreparedValue (PSESQLExp sqlExp) = P.UVLiteral sqlExp
|
||
|
||
mapField
|
||
:: Functor m
|
||
=> P.InputFieldsParser m (Maybe a)
|
||
-> (a -> b)
|
||
-> P.InputFieldsParser m (Maybe b)
|
||
mapField fp f = fmap (fmap f) fp
|
||
|
||
parsedSelectionsToFields
|
||
:: (Text -> a) -- ^ how to handle @__typename@ fields
|
||
-> OMap.InsOrdHashMap G.Name (P.ParsedSelection a)
|
||
-> IR.Fields a
|
||
parsedSelectionsToFields mkTypename = OMap.toList
|
||
>>> map (FieldName . G.unName *** P.handleTypename (mkTypename . G.unName))
|
||
|
||
numericAggOperators :: [G.Name]
|
||
numericAggOperators =
|
||
[ $$(G.litName "sum")
|
||
, $$(G.litName "avg")
|
||
, $$(G.litName "stddev")
|
||
, $$(G.litName "stddev_samp")
|
||
, $$(G.litName "stddev_pop")
|
||
, $$(G.litName "variance")
|
||
, $$(G.litName "var_samp")
|
||
, $$(G.litName "var_pop")
|
||
]
|
||
|
||
comparisonAggOperators :: [G.Name]
|
||
comparisonAggOperators = [$$(litName "max"), $$(litName "min")]
|
||
|
||
data NodeIdVersion
|
||
= NIVersion1
|
||
deriving (Show, Eq)
|
||
|
||
nodeIdVersionInt :: NodeIdVersion -> Int
|
||
nodeIdVersionInt NIVersion1 = 1
|
||
|
||
currentNodeIdVersion :: NodeIdVersion
|
||
currentNodeIdVersion = NIVersion1
|
||
|
||
instance J.FromJSON NodeIdVersion where
|
||
parseJSON v = do
|
||
versionInt :: Int <- J.parseJSON v
|
||
case versionInt of
|
||
1 -> pure NIVersion1
|
||
_ -> fail $ "expecting version 1 for node id, but got " <> show versionInt
|
||
|
||
mkDescriptionWith :: Maybe PG.PGDescription -> Text -> G.Description
|
||
mkDescriptionWith descM defaultTxt = G.Description $ case descM of
|
||
Nothing -> defaultTxt
|
||
Just (PG.PGDescription descTxt) -> T.unlines [descTxt, "\n", defaultTxt]
|
||
|
||
-- TODO why do we do these validations at this point? What does it mean to track
|
||
-- a function but not add it to the schema...?
|
||
-- Auke:
|
||
-- I believe the intention is simply to allow the console to do postgres data management
|
||
-- Karthikeyan: Yes, this is correct. We allowed this pre PDV but somehow
|
||
-- got removed in PDV. OTOH, I’m not sure how prevalent this feature
|
||
-- actually is
|
||
takeValidTables :: forall b. Backend b => TableCache b -> TableCache b
|
||
takeValidTables = Map.filterWithKey graphQLTableFilter . Map.filter tableFilter
|
||
where
|
||
tableFilter = not . isSystemDefined . _tciSystemDefined . _tiCoreInfo
|
||
graphQLTableFilter tableName tableInfo =
|
||
-- either the table name should be GraphQL compliant
|
||
-- or it should have a GraphQL custom name set with it
|
||
isRight (tableGraphQLName @b tableName) ||
|
||
isJust (_tcCustomName $ _tciCustomConfig $ _tiCoreInfo tableInfo)
|
||
|
||
-- TODO and what about graphql-compliant function names here too?
|
||
takeValidFunctions :: forall b. FunctionCache b -> FunctionCache b
|
||
takeValidFunctions = Map.filter functionFilter
|
||
where
|
||
functionFilter = not . isSystemDefined . _fiSystemDefined
|
||
|
||
|
||
-- root field builder helpers
|
||
|
||
requiredFieldParser
|
||
:: (Functor n, Functor m)
|
||
=> (a -> b)
|
||
-> m (P.FieldParser n a)
|
||
-> m (Maybe (P.FieldParser n b))
|
||
requiredFieldParser f = fmap $ Just . fmap f
|
||
|
||
optionalFieldParser
|
||
:: (Functor n, Functor m)
|
||
=> (a -> b)
|
||
-> m (Maybe (P.FieldParser n a))
|
||
-> m (Maybe (P.FieldParser n b))
|
||
optionalFieldParser = fmap . fmap . fmap
|