Feature/gdw execute and metadata [GDW-74]

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4195
Co-authored-by: Daniel Chambers <1214352+daniel-chambers@users.noreply.github.com>
GitOrigin-RevId: 2508b604e7453c2efaa2f7096b2b4b2ce6885d2d
This commit is contained in:
Solomon 2022-04-13 19:06:07 -07:00 committed by hasura-bot
parent 74328156c5
commit 893fb8cd92
7 changed files with 403 additions and 61 deletions

View File

@ -6,6 +6,7 @@ module Hasura.Backends.DataWrapper.Adapter.Backend () where
import Data.Aeson qualified as J (Value)
import Hasura.Backends.DataWrapper.Adapter.Types qualified as Adapter
import Hasura.Backends.DataWrapper.Agent.Client qualified as Agent.Client
import Hasura.Backends.DataWrapper.IR.Column qualified as Column (Name)
import Hasura.Backends.DataWrapper.IR.Expression (Expression, Operator)
import Hasura.Backends.DataWrapper.IR.Function qualified as Function (Name)
@ -36,7 +37,7 @@ type Unimplemented = ()
instance Backend 'DataWrapper where
type SourceConfig 'DataWrapper = Adapter.SourceConfig
type SourceConnConfiguration 'DataWrapper = Unimplemented
type SourceConnConfiguration 'DataWrapper = Agent.Client.ConnSourceConfig
type TableName 'DataWrapper = Table.Name
type FunctionName 'DataWrapper = Function.Name

View File

@ -10,7 +10,7 @@ where
import Data.Aeson qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.Text.Encoding qualified as TE
import Hasura.Backends.DataWrapper.API (Capabilities (dcRelationships), SchemaResponse (srCapabilities))
import Hasura.Backends.DataWrapper.API (Capabilities (dcRelationships), Routes (..), SchemaResponse (srCapabilities))
import Hasura.Backends.DataWrapper.Agent.Client
import Hasura.Backends.DataWrapper.IR.Query qualified as IR
import Hasura.Backends.DataWrapper.Plan qualified as GDW
@ -70,7 +70,7 @@ toExplainPlan fieldName plan_ =
buildAction :: GDW.SourceConfig -> IR.Query -> Tracing.TraceT (ExceptT QErr IO) EncJSON
buildAction GDW.SourceConfig {..} query = do
-- TODO(SOLOMON): Should this check occur during query construction in 'mkPlan'?
unless (dcRelationships (srCapabilities dscSchema) && GDW.queryHasRelations query) $
when (GDW.queryHasRelations query && not (dcRelationships (srCapabilities dscSchema))) $
throw400 NotSupported "Agents must provide their own dataloader."
Routes {..} <- liftIO $ client @(Tracing.TraceT (ExceptT QErr IO)) dscManager (ConnSourceConfig dscEndpoint)
queryResponse <- _query $ Witch.from query

View File

@ -3,19 +3,199 @@
module Hasura.Backends.DataWrapper.Adapter.Metadata () where
--------------------------------------------------------------------------------
import Data.Aeson qualified as J
import Data.Environment (Environment)
import Data.HashMap.Strict qualified as Map
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text.Extended (toTxt)
import Hasura.Backends.DataWrapper.API qualified as API
import Hasura.Backends.DataWrapper.Adapter.Types qualified as GDW
( SourceConfig (..),
)
import Hasura.Backends.DataWrapper.Agent.Client qualified as Agent.Client
import Hasura.Backends.DataWrapper.IR.Expression qualified as IR
import Hasura.Backends.DataWrapper.IR.Name qualified as IR
import Hasura.Backends.DataWrapper.IR.Scalar.Type qualified as IR.Scalar
import Hasura.Backends.DataWrapper.IR.Table qualified as IR.Table
import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
import Hasura.Base.Error (Code (..), QErr, throw400, withPathK)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (OpExpG (..), PartialSQLExp (..))
import Hasura.RQL.Types.Column (ColumnMutability (..), ColumnReference, ColumnType (..), RawColumnInfo (..), ValueParser, columnReferenceType, parseScalarValueColumnType)
import Hasura.RQL.Types.Common (OID (..), SourceName)
import Hasura.RQL.Types.Metadata (SourceMetadata (..))
import Hasura.RQL.Types.Metadata.Backend (BackendMetadata (..))
import Hasura.SQL.Backend (BackendType (DataWrapper))
import Hasura.RQL.Types.Source (ResolvedSource (..))
import Hasura.RQL.Types.SourceCustomization (SourceTypeCustomization)
import Hasura.RQL.Types.Table (Constraint (..), DBTableMetadata (..), FieldInfo, FieldInfoMap, PrimaryKey (..), ViewInfo (..))
import Hasura.SQL.Backend (BackendType (..))
import Hasura.SQL.Types (CollectableType (..))
import Hasura.Server.Utils (isReqUserId, isSessionVariable, userIdHeader)
import Hasura.Session (SessionVariable, mkSessionVariable)
import Hasura.Tracing (noReporter, runTraceTWithReporter)
import Language.GraphQL.Draft.Syntax qualified as GQL
import Network.HTTP.Client qualified as HTTP
import Witch qualified
--------------------------------------------------------------------------------
instance BackendMetadata 'DataWrapper where
resolveSourceConfig = error "resolveSourceConfig: not implemented for GraphQL Data Wrappers."
resolveDatabaseMetadata = error "resolveDatabaseMetadata: not implemented for GraphQL Data Wrappers."
parseBoolExpOperations = error "parseBoolExpOperations: not implemented for GraphQL Data Wrappers."
parseCollectableType = error "parseCollectableType: not implemented for GraphQL Data Wrappers."
resolveSourceConfig = resolveSourceConfig'
resolveDatabaseMetadata = resolveDatabaseMetadata'
parseBoolExpOperations = parseBoolExpOperations'
parseCollectableType = parseCollectableType'
buildComputedFieldInfo = error "buildComputedFieldInfo: not implemented for GraphQL Data Wrappers."
fetchAndValidateEnumValues = error "fetchAndValidateEnumValues: not implemented for GraphQL Data Wrappers."
buildFunctionInfo = error "buildFunctionInfo: not implemented for GraphQL Data Wrappers."
updateColumnInEventTrigger = error "updateColumnInEventTrigger: not implemented for GraphQL Data Wrappers."
postDropSourceHook = error "postDropSourceHook: not implemented for GraphQL Data Wrappers."
resolveSourceConfig' ::
MonadIO m =>
SourceName ->
Agent.Client.ConnSourceConfig ->
Environment ->
m (Either QErr GDW.SourceConfig)
resolveSourceConfig' _ (Agent.Client.ConnSourceConfig endpoint) _ = runExceptT do
manager <- liftIO $ HTTP.newManager HTTP.defaultManagerSettings
API.Routes {..} <- liftIO $ Agent.Client.client manager (Agent.Client.ConnSourceConfig endpoint)
schemaResponse <- runTraceTWithReporter noReporter "resolve source" _schema
pure
GDW.SourceConfig
{ dscEndpoint = endpoint,
dscSchema = schemaResponse,
dscManager = manager
}
resolveDatabaseMetadata' ::
Applicative m =>
SourceMetadata 'DataWrapper ->
GDW.SourceConfig ->
SourceTypeCustomization ->
m (Either QErr (ResolvedSource 'DataWrapper))
resolveDatabaseMetadata' _ sc@(GDW.SourceConfig _ (API.SchemaResponse {..}) _) customization =
let tables = Map.fromList $ do
API.TableInfo {..} <- srTables
let meta =
DBTableMetadata
{ _ptmiOid = OID 0,
_ptmiColumns = do
API.ColumnInfo {..} <- dtiColumns
pure $
RawColumnInfo
{ rciName = Witch.from dciName,
rciPosition = 1,
rciType = Witch.from dciType,
rciIsNullable = dciNullable,
rciDescription = fmap GQL.Description dciDescription,
-- TODO: Add Column Mutability to the 'TableInfo'
rciMutability = ColumnMutability False False
},
_ptmiPrimaryKey = dtiPrimaryKey <&> \key -> PrimaryKey (Constraint () (OID 0)) (NESeq.singleton (coerce key)),
_ptmiUniqueConstraints = mempty,
_ptmiForeignKeys = mempty,
_ptmiViewInfo = Just $ ViewInfo False False False,
_ptmiDescription = fmap PGDescription dtiDescription,
_ptmiExtraTableMetadata = ()
}
pure (coerce dtiName, meta)
in pure $
pure $
ResolvedSource
{ _rsConfig = sc,
_rsCustomization = customization,
_rsTables = tables,
_rsFunctions = mempty,
_rsPgScalars = mempty
}
-- | This is needed to get permissions to work
parseBoolExpOperations' ::
forall m v.
MonadError QErr m =>
ValueParser 'DataWrapper m v ->
IR.Table.Name ->
FieldInfoMap (FieldInfo 'DataWrapper) ->
ColumnReference 'DataWrapper ->
J.Value ->
m [OpExpG 'DataWrapper v]
parseBoolExpOperations' rhsParser _table _fields columnRef value =
withPathK (toTxt columnRef) $ parseOperations (columnReferenceType columnRef) value
where
parseWithTy ty = rhsParser (CollectableTypeScalar ty)
parseOperations :: ColumnType 'DataWrapper -> J.Value -> m [OpExpG 'DataWrapper v]
parseOperations columnType = \case
J.Object o -> mapM (parseOperation columnType) $ Map.toList o
v -> pure . AEQ False <$> parseWithTy columnType v
parseOperation :: ColumnType 'DataWrapper -> (Text, J.Value) -> m (OpExpG 'DataWrapper v)
parseOperation columnType (opStr, val) = withPathK opStr $
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
-- "$in" -> parseIn
-- "_in" -> parseIn
--
-- "$nin" -> parseNin
-- "_nin" -> parseNin
-- "$like" -> parseLike
-- "_like" -> parseLike
--
-- "$nlike" -> parseNlike
-- "_nlike" -> parseNlike
x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x
where
-- colTy = columnReferenceType columnRef
parseOne = parseWithTy columnType val
-- parseManyWithType ty = rhsParser (CollectableTypeArray ty) val
parseEq = AEQ False <$> parseOne
parseNeq = ANE False <$> parseOne
-- parseIn = AIN <$> parseManyWithType colTy
-- parseNin = ANIN <$> parseManyWithType colTy
parseGt = AGT <$> parseOne
parseLt = ALT <$> parseOne
parseGte = AGTE <$> parseOne
parseLte = ALTE <$> parseOne
parseCollectableType' ::
MonadError QErr m =>
CollectableType (ColumnType 'DataWrapper) ->
J.Value ->
m (PartialSQLExp 'DataWrapper)
parseCollectableType' collectableType = \case
J.String t
| isSessionVariable t -> pure $ mkTypedSessionVar collectableType $ mkSessionVariable t
| isReqUserId t -> pure $ mkTypedSessionVar collectableType userIdHeader
val -> case collectableType of
CollectableTypeScalar scalarType ->
PSESQLExp . IR.Literal <$> parseScalarValueColumnType scalarType val
CollectableTypeArray _ ->
throw400 NotSupported "Array types are not supported by dynamic backends"
mkTypedSessionVar ::
CollectableType (ColumnType 'DataWrapper) ->
SessionVariable ->
PartialSQLExp 'DataWrapper
mkTypedSessionVar columnType =
PSESessVar (columnTypeToScalarType <$> columnType)
columnTypeToScalarType :: ColumnType 'DataWrapper -> IR.Scalar.Type
columnTypeToScalarType = \case
ColumnScalar scalarType -> scalarType
ColumnEnumReference _ -> IR.Scalar.String -- is this even reachable?

View File

@ -1,14 +1,27 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.DataWrapper.Adapter.Schema () where
--------------------------------------------------------------------------------
import Hasura.GraphQL.Schema.Backend (BackendSchema (..), MonadBuildSchema)
import Data.List.NonEmpty qualified as NE
import Data.Text.Extended ((<<>))
import Hasura.Backends.DataWrapper.IR.OrderBy qualified as IR
import Hasura.Backends.DataWrapper.IR.Scalar.Type qualified as Scalar.Type (Type (..))
import Hasura.Backends.DataWrapper.IR.Scalar.Value qualified as Scalar.Value (Value (..))
import Hasura.Base.Error
import Hasura.GraphQL.Parser (Definition (..), Kind (..), Parser, ValueWithOrigin)
import Hasura.GraphQL.Parser qualified as P
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Backend (BackendSchema (..), ComparisonExp, MonadBuildSchema)
import Hasura.GraphQL.Schema.Build qualified as GSB
import Hasura.GraphQL.Schema.Select qualified as GSS
import Hasura.Prelude
import Hasura.RQL.IR.Select (SelectArgsG (..))
import Hasura.RQL.Types qualified as RQL
import Hasura.SQL.Backend (BackendType (DataWrapper))
import Language.GraphQL.Draft.Syntax qualified as G
import Language.GraphQL.Draft.Syntax qualified as GraphQL
--------------------------------------------------------------------------------
@ -19,35 +32,25 @@ instance BackendSchema 'DataWrapper where
buildTableRelayQueryFields = experimentalBuildTableRelayQueryFields
buildFunctionQueryFields =
error "buildFunctionQueryFields: not implemented for GraphQL Data Wrappers."
buildFunctionRelayQueryFields =
error "buildFunctionRelayQueryFields: not implemented for GraphQL Data Wrappers."
buildFunctionMutationFields =
error "buildFunctionMutationFields: not implemented for GraphQL Data Wrappers."
buildTableInsertMutationFields =
error "buildTableInsertMutationFields: not implemented for GraphQL Data Wrappers."
buildTableUpdateMutationFields =
error "buildTableUpdateMutationFields: not implemented for GraphQL Data Wrappers."
buildTableDeleteMutationFields =
error "buildTableDeleteMutationFields: not implemented for GraphQL Data Wrappers."
buildFunctionQueryFields _ _ _ _ = pure []
buildFunctionRelayQueryFields _ _ _ _ _ = pure []
buildFunctionMutationFields _ _ _ _ = pure []
buildTableInsertMutationFields _ _ _ _ _ = pure []
buildTableUpdateMutationFields _ _ _ _ = pure []
buildTableDeleteMutationFields _ _ _ _ = pure []
-- backend extensions
relayExtension = Nothing
nodesAggExtension = Nothing
-- table arguments
tableArguments =
error "tableArguments: not implemented for GraphQL Data Wrappers."
tableArguments = tableArgs'
-- indivdual components
columnParser =
error "columnParser: not implemented for GraphQL Data Wrappers."
-- individual components
columnParser = columnParser'
jsonPathArg _ = pure Nothing
orderByOperators =
error "orderByOperators: not implemented for GraphQL Data Wrappers."
comparisonExps =
error "comparisonExps: not implemented for GraphQL Data Wrappers."
orderByOperators = orderByOperators'
comparisonExps = comparisonExps'
countTypeInput =
error "countTypeInput: not implemented for GraphQL Data Wrappers."
@ -72,3 +75,94 @@ experimentalBuildTableRelayQueryFields ::
m [a]
experimentalBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns =
pure []
columnParser' ::
(MonadSchema n m, MonadError QErr m) =>
RQL.ColumnType 'DataWrapper ->
G.Nullability ->
m (Parser 'Both n (ValueWithOrigin (RQL.ColumnValue 'DataWrapper)))
columnParser' columnType (G.Nullability isNullable) = do
parser <- case columnType of
RQL.ColumnScalar Scalar.Type.String -> pure (Scalar.Value.String <$> P.string)
RQL.ColumnScalar Scalar.Type.Number -> pure (Scalar.Value.Number <$> P.scientific)
RQL.ColumnScalar Scalar.Type.Bool -> pure (Scalar.Value.Boolean <$> P.boolean)
_ -> throw400 NotSupported "This column type is unsupported by the dynamic backend"
pure . P.peelWithOrigin . fmap (RQL.ColumnValue columnType) . possiblyNullable $ parser
where
possiblyNullable ::
MonadParse m =>
Parser 'Both m Scalar.Value.Value ->
Parser 'Both m Scalar.Value.Value
possiblyNullable
| isNullable = fmap (fromMaybe Scalar.Value.Null) . P.nullable
| otherwise = id
orderByOperators' :: NonEmpty (Definition P.EnumValueInfo, (RQL.BasicOrderType 'DataWrapper, RQL.NullsOrderType 'DataWrapper))
orderByOperators' =
NE.fromList
[ ( define $$(G.litName "asc") "in ascending order",
(IR.Ascending, ())
),
( define $$(G.litName "desc") "in descending order",
(IR.Descending, ())
)
]
where
define name desc = P.Definition name (Just desc) P.EnumValueInfo
comparisonExps' ::
forall m n.
( BackendSchema 'DataWrapper,
MonadSchema n m,
MonadError QErr m
) =>
RQL.ColumnType 'DataWrapper ->
m (Parser 'Input n [ComparisonExp 'DataWrapper])
comparisonExps' = P.memoize 'comparisonExps' \columnType -> do
typedParser <- columnParser' columnType (G.Nullability False)
nullableTextParser <- columnParser' (RQL.ColumnScalar Scalar.Type.String) (G.Nullability True)
textParser <- columnParser' (RQL.ColumnScalar Scalar.Type.String) (G.Nullability False)
let name = P.getName typedParser <> $$(G.litName "_Dynamic_comparison_exp")
desc =
G.Description $
"Boolean expression to compare columns of type "
<> P.getName typedParser
<<> ". All fields are combined with logical 'AND'."
textListParser = fmap P.openValueOrigin <$> P.list textParser
columnListParser = fmap P.openValueOrigin <$> P.list typedParser
pure $
P.object name (Just desc) $
catMaybes
<$> sequenceA
[ P.fieldOptional $$(G.litName "_is_null") Nothing (bool RQL.ANISNOTNULL RQL.ANISNULL <$> P.boolean),
P.fieldOptional $$(G.litName "_eq") Nothing (RQL.AEQ True . P.mkParameter <$> typedParser),
P.fieldOptional $$(G.litName "_neq") Nothing (RQL.ANE True . P.mkParameter <$> typedParser),
P.fieldOptional $$(G.litName "_gt") Nothing (RQL.AGT . P.mkParameter <$> typedParser),
P.fieldOptional $$(G.litName "_lt") Nothing (RQL.ALT . P.mkParameter <$> typedParser),
P.fieldOptional $$(G.litName "_gte") Nothing (RQL.AGTE . P.mkParameter <$> typedParser),
P.fieldOptional $$(G.litName "_lte") Nothing (RQL.ALTE . P.mkParameter <$> typedParser)
]
tableArgs' ::
forall r m n.
MonadBuildSchema 'DataWrapper r m n =>
RQL.SourceName ->
RQL.TableInfo 'DataWrapper ->
m (P.InputFieldsParser n (SelectArgsG 'DataWrapper (P.UnpreparedValue 'DataWrapper)))
tableArgs' sourceName tableInfo = do
whereParser <- GSS.tableWhereArg sourceName tableInfo
orderByParser <- GSS.tableOrderByArg sourceName tableInfo
let mkSelectArgs whereArg orderByArg limitArg offsetArg =
SelectArgs
{ _saWhere = whereArg,
_saOrderBy = orderByArg,
_saLimit = limitArg,
_saOffset = offsetArg,
_saDistinct = Nothing
}
pure $
mkSelectArgs
<$> whereParser
<*> orderByParser
<*> GSS.tableLimitArg
<*> GSS.tableOffsetArg

View File

@ -5,22 +5,79 @@ module Hasura.Backends.DataWrapper.Adapter.Transport () where
--------------------------------------------------------------------------------
import Control.Exception.Safe (throwIO)
import Data.Aeson qualified as J
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataWrapper.Adapter.Execute ()
import Hasura.Base.Error (Code (NotSupported), throw400)
import Hasura.Backends.DataWrapper.Adapter.Types (SourceConfig)
import Hasura.Backends.DataWrapper.Plan qualified as GDW
import Hasura.Base.Error (Code (NotSupported), QErr, throw400)
import Hasura.EncJSON (EncJSON)
import Hasura.GraphQL.Execute.Backend (DBStepInfo (..))
import Hasura.GraphQL.Logging (GeneratedQuery (GeneratedQuery), MonadQueryLog (..), QueryLog (..), QueryLogKind (..))
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.Backend (BackendTransport (..))
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
import Hasura.Logging (Hasura, Logger)
import Hasura.Prelude
import Hasura.SQL.Backend (BackendType (DataWrapper))
import Hasura.Server.Types (RequestId)
import Hasura.Session (UserInfo)
import Hasura.Tracing qualified as Tracing
--------------------------------------------------------------------------------
instance BackendTransport 'DataWrapper where
runDBQuery _ _ _ _ _ _ _ _ =
throw400 NotSupported "runDBQuery: not implemented for GraphQL Data Wrappers."
runDBQueryExplain _ =
throw400 NotSupported "runDBQueryExplain: not implemented for GraphQL Data Wrappers."
runDBQuery = runDBQuery'
runDBQueryExplain = runDBQueryExplain'
runDBMutation _ _ _ _ _ _ _ _ =
throw400 NotSupported "runDBMutation: not implemented for GraphQL Data Wrappers."
runDBStreamingSubscription _ _ _ =
liftIO . throwIO $ userError "runDBStreamingSubscription: not implemented for GraphQL Data Wrappers."
runDBSubscription _ _ _ =
liftIO . throwIO $ userError "runDBSubscription: not implemented for GraphQL Data Wrappers."
runDBQuery' ::
( MonadIO m,
MonadError QErr m,
Tracing.MonadTrace m,
MonadQueryLog m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
Logger Hasura ->
SourceConfig ->
Tracing.TraceT (ExceptT QErr IO) a ->
Maybe GDW.Plan ->
m (DiffTime, a)
runDBQuery' requestId query fieldName _userInfo logger _sourceConfig action ir = do
void $ logQueryLog logger $ mkQueryLog query fieldName ir requestId
withElapsedTime
. Tracing.trace ("Dynamic backend query for root field " <>> fieldName)
. Tracing.interpTraceT (liftEitherM . liftIO . runExceptT)
$ action
mkQueryLog ::
GQLReqUnparsed ->
RootFieldAlias ->
Maybe GDW.Plan ->
RequestId ->
QueryLog
mkQueryLog gqlQuery fieldName maybePlan requestId =
QueryLog
gqlQuery
((\plan -> (fieldName, GeneratedQuery (GDW.renderPlan plan) J.Null)) <$> maybePlan)
requestId
QueryLogKindDatabase
runDBQueryExplain' ::
(MonadIO m, MonadError QErr m) =>
DBStepInfo 'DataWrapper ->
m EncJSON
runDBQueryExplain' (DBStepInfo _ _ _ action) =
liftEitherM $
liftIO $
runExceptT $
Tracing.runTraceTWithReporter Tracing.noReporter "explain" $
action

View File

@ -3,58 +3,55 @@
--
module Hasura.Backends.DataWrapper.Agent.Client
( ConnSourceConfig (..),
Routes (..),
Hasura.Backends.DataWrapper.Agent.Client.client,
)
where
import Control.Exception (try)
import Control.Monad.Free
import Data.Text (unpack)
-- import Hasura.Tracing (MonadTrace, tracedHttpRequest)
-- import qualified Network.HTTP.Client.Transformable as Transformable
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Text (unpack)
import Hasura.Backends.DataWrapper.API qualified as API
import Hasura.Backends.DataWrapper.API.V0.Schema
import Hasura.Base.Error
import Hasura.Incremental.Internal.Dependency (Cacheable (..))
import Hasura.Prelude
import Network.HTTP.Client (Manager)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types.Status (statusCode, statusMessage)
import Servant.API
import Servant.API.Generic
import Servant.Client
import Servant.Client.Core.RunClient (ClientF (..))
import Servant.Client.Generic
import Servant.Client.Internal.HttpClient (clientResponseToResponse)
--------------------------------------------------------------------------------
-- Servant Routes
data Routes mode = Routes
{ -- | 'GET /schema'
_schema ::
mode :- "schema"
:> Get '[JSON] SchemaResponse,
-- | 'POST /query'
_query ::
mode :- "query"
:> ReqBody '[JSON] API.Query
:> Post '[JSON] QueryResponse
}
deriving (Generic)
--------------------------------------------------------------------------------
-- Client
data ConnSourceConfig = ConnSourceConfig
newtype ConnSourceConfig = ConnSourceConfig
{ dcscEndpoint :: Text
}
deriving stock (Eq, Ord, Show, Generic, Data)
deriving anyclass (Hashable, NFData, Cacheable)
instance ToJSON ConnSourceConfig where
toJSON =
J.genericToJSON $
J.defaultOptions
{ J.fieldLabelModifier = J.snakeCase . drop 4
}
instance FromJSON ConnSourceConfig where
parseJSON =
J.genericParseJSON $
J.defaultOptions
{ J.fieldLabelModifier = J.snakeCase . drop 4
}
-- | Create a record of client functions (see 'Routes') from a 'ConnSourceConfig'
-- configuration object. This function takes care to add trace headers, and to
-- propagate useful errors back to the client for debugging purposes.
@ -63,7 +60,7 @@ client ::
(MonadIO m {- MonadTrace m, -}, MonadError QErr m) =>
Manager ->
ConnSourceConfig ->
IO (Routes (AsClientT m))
IO (API.Routes (AsClientT m))
client mgr config = do
baseUrl <- parseBaseUrl (unpack (dcscEndpoint config))
let interpret :: ClientF a -> m a

View File

@ -5,6 +5,7 @@ module Hasura.Backends.DataWrapper.Plan
( SourceConfig (..),
Plan (..),
mkPlan,
renderPlan,
queryHasRelations,
)
where
@ -13,12 +14,15 @@ where
import Data.Aeson qualified as J
import Data.Align
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Semigroup (Any (..), Min (..))
import Data.Text.Encoding qualified as TE
import Data.These
import Data.Vector qualified as Vector
import Hasura.Backends.DataWrapper.API (Capabilities (..), QueryResponse (..), SchemaResponse (..))
import Hasura.Backends.DataWrapper.API qualified as API
import Hasura.Backends.DataWrapper.Adapter.Types
import Hasura.Backends.DataWrapper.IR.Expression qualified as IR
import Hasura.Backends.DataWrapper.IR.Expression qualified as IR.Expression
@ -37,6 +41,7 @@ import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend
import Hasura.Session
import Witch qualified
--------------------------------------------------------------------------------
@ -59,6 +64,13 @@ data ResponseError
| UnexpectedResponseCardinality
deriving (Show, Eq)
-- | Extract the 'IR.Query' from a 'Plan' and render it as 'Text'.
--
-- NOTE: This is for logging and debug purposes only.
renderPlan :: Plan -> Text
renderPlan =
TE.decodeUtf8 . BL.toStrict . J.encode . Witch.from @_ @API.Query . query
-- | Map a 'QueryDB 'DataWrapper' term into a 'Plan'
mkPlan ::
forall m.
@ -144,11 +156,12 @@ mkPlan session (SourceConfig _ SchemaResponse {srCapabilities} _) ir = translate
fields <- traverse (traverse (translateField card)) xs
pure $
HashMap.fromList $
catMaybes $
fmap sequence $
[ (getFieldNameTxt f, field)
mapMaybe
sequence
( [ (getFieldNameTxt f, field)
| (f, field) <- fields
]
)
translateField ::
IR.Query.Cardinality ->