Data Connector Agent Configuration Schema [GDW-103]

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4450
GitOrigin-RevId: 2dce6e901c9734407d084d57166039fd94394279
This commit is contained in:
Daniel Chambers 2022-05-05 15:18:43 +10:00 committed by hasura-bot
parent a06abcea86
commit 97ac9cbcdc
10 changed files with 338 additions and 37 deletions

View File

@ -139,7 +139,9 @@ library dc-api
, bytestring
, deepseq
, hashable
, insert-ordered-containers
, lens
, lens-aeson
, openapi3
, scientific
, servant
@ -156,6 +158,7 @@ library dc-api
, Hasura.Backends.DataConnector.API
, Hasura.Backends.DataConnector.API.V0.API
, Hasura.Backends.DataConnector.API.V0.Column
, Hasura.Backends.DataConnector.API.V0.ConfigSchema
, Hasura.Backends.DataConnector.API.V0.Expression
, Hasura.Backends.DataConnector.API.V0.OrderBy
, Hasura.Backends.DataConnector.API.V0.Query
@ -929,6 +932,7 @@ test-suite graphql-engine-tests
Hasura.AppSpec
Hasura.Backends.DataConnector.API.V0Spec
Hasura.Backends.DataConnector.API.V0.ColumnSpec
Hasura.Backends.DataConnector.API.V0.ConfigSchemaSpec
Hasura.Backends.DataConnector.API.V0.ExpressionSpec
Hasura.Backends.DataConnector.API.V0.OrderBySpec
Hasura.Backends.DataConnector.API.V0.QuerySpec
@ -1168,6 +1172,7 @@ test-suite tests-dc-api
Command
, Paths_graphql_engine
, Test.Data
, Test.ConfigSchemaSpec
, Test.QuerySpec
, Test.QuerySpec.BasicSpec
, Test.QuerySpec.RelationshipsSpec

View File

@ -4,22 +4,16 @@ module Hasura.Backends.DataConnector.API
Api,
SchemaApi,
QueryApi,
Config (..),
ConfigHeader,
openApiSchema,
openApiSchemaJson,
Routes (..),
apiClient,
)
where
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.ByteString.Lazy qualified as BSL
import Data.Data (Proxy (..))
import Data.Hashable (Hashable)
import Data.OpenApi (AdditionalProperties (..), OpenApi, OpenApiType (..), Schema (..), ToParamSchema (..))
import Data.Text.Encoding qualified as Text
import Data.OpenApi (OpenApi)
import Hasura.Backends.DataConnector.API.V0.API as V0
import Servant.API
import Servant.API.Generic
@ -30,6 +24,10 @@ import Prelude
--------------------------------------------------------------------------------
-- Servant Routes
type ConfigSchemaApi =
"config-schema"
:> Get '[JSON] V0.ConfigSchemaResponse
type SchemaApi =
"schema"
:> ConfigHeader
@ -41,26 +39,12 @@ type QueryApi =
:> ReqBody '[JSON] V0.Query
:> Post '[JSON] V0.QueryResponse
newtype Config = Config {unConfig :: J.Object}
deriving stock (Eq, Show, Ord)
deriving newtype (Hashable, NFData, ToJSON, FromJSON)
instance ToHttpApiData Config where
toUrlPiece (Config val) = Text.decodeUtf8 . BSL.toStrict $ J.encode val
toHeader (Config val) = BSL.toStrict $ J.encode val
instance ToParamSchema Config where
toParamSchema _ =
mempty
{ _schemaType = Just OpenApiObject,
_schemaNullable = Just False,
_schemaAdditionalProperties = Just (AdditionalPropertiesAllowed True)
}
type ConfigHeader = Header' '[Required, Strict] "X-Hasura-DataConnector-Config" Config
type ConfigHeader = Header' '[Required, Strict] "X-Hasura-DataConnector-Config" V0.Config
data Routes mode = Routes
{ -- | 'GET /schema'
{ -- | 'GET /config-schema'
_configSchema :: mode :- ConfigSchemaApi,
-- | 'GET /schema'
_schema :: mode :- SchemaApi,
-- | 'POST /query'
_query :: mode :- QueryApi
@ -69,12 +53,19 @@ data Routes mode = Routes
-- | servant-openapi3 does not (yet) support NamedRoutes so we need to compose the
-- API the old-fashioned way using :<|> for use by @toOpenApi@
type Api = SchemaApi :<|> QueryApi
type Api = ConfigSchemaApi :<|> SchemaApi :<|> QueryApi
-- | Provide an OpenApi 3.0 schema for the API
openApiSchema :: OpenApi
openApiSchema = toOpenApi (Proxy :: Proxy Api)
-- | The OpenAPI 3.0 schema for the API
--
-- This is not exposed as the 'OpenApi' type because we need to do some hackery in
-- the serialized JSON to work around some limitations in the openapi3 library
openApiSchemaJson :: J.Value
openApiSchemaJson = V0.fixExternalSchemaRefsInComponentSchemas $ J.toJSON openApiSchema
apiClient :: Client ClientM (NamedRoutes Routes)
apiClient =
client (Proxy @(NamedRoutes Routes))

View File

@ -1,6 +1,7 @@
--
module Hasura.Backends.DataConnector.API.V0.API
( module Column,
module ConfigSchema,
module Expression,
module OrderBy,
module Query,
@ -12,6 +13,7 @@ module Hasura.Backends.DataConnector.API.V0.API
where
import Hasura.Backends.DataConnector.API.V0.Column as Column
import Hasura.Backends.DataConnector.API.V0.ConfigSchema as ConfigSchema
import Hasura.Backends.DataConnector.API.V0.Expression as Expression
import Hasura.Backends.DataConnector.API.V0.OrderBy as OrderBy
import Hasura.Backends.DataConnector.API.V0.Query as Query

View File

@ -0,0 +1,173 @@
{-# LANGUAGE ViewPatterns #-}
module Hasura.Backends.DataConnector.API.V0.ConfigSchema
( Config (..),
ConfigSchemaResponse (..),
validateConfigAgainstConfigSchema,
fixExternalSchemaRefsInComponentSchemas,
fixExternalSchemaRefsInSchema,
)
where
import Control.DeepSeq (NFData)
import Control.Lens ((%~), (&), (.~), (^?))
import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, (.:), (.=), (<?>))
import Data.Aeson.Lens (AsPrimitive (..), key, members, values)
import Data.Aeson.Types (JSONPathElement (..))
import Data.ByteString.Lazy qualified as BSL
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.OpenApi (AdditionalProperties (..), Definitions, NamedSchema (..), OpenApiType (..), Reference (..), Referenced (..), Schema (..), ToParamSchema (..), ToSchema (..), ValidationError)
import Data.OpenApi qualified as OpenApi
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Servant.API (ToHttpApiData (..))
import Prelude
newtype Config = Config {unConfig :: Object}
deriving stock (Eq, Show, Ord)
deriving newtype (Hashable, NFData, ToJSON, FromJSON)
instance ToHttpApiData Config where
toUrlPiece (Config val) = Text.decodeUtf8 . BSL.toStrict $ encode val
toHeader (Config val) = BSL.toStrict $ encode val
instance ToParamSchema Config where
toParamSchema _ =
mempty
{ _schemaType = Just OpenApiObject,
_schemaNullable = Just False,
_schemaAdditionalProperties = Just (AdditionalPropertiesAllowed True)
}
data ConfigSchemaResponse = ConfigSchemaResponse
{ _csrConfigSchema :: Schema,
_csrOtherSchemas :: Definitions Schema
}
deriving (Show, Eq)
instance FromJSON ConfigSchemaResponse where
parseJSON = withObject "ConfigSchemaResponse" $ \obj -> do
configSchemaValue <- obj .: "configSchema"
(otherSchemaValues :: Object) <- obj .: "otherSchemas"
_csrConfigSchema <- parseJSON (rewriteConfigSchemaRefsToOpenApiRefs configSchemaValue) <?> Key "configSchema"
_csrOtherSchemas <- (<?> Key "otherSchemas") . parseJSON . Object $ rewriteConfigSchemaRefsToOpenApiRefs <$> otherSchemaValues
pure ConfigSchemaResponse {..}
instance ToJSON ConfigSchemaResponse where
toJSON ConfigSchemaResponse {..} =
let configSchemaValue = rewriteOpenApiRefsToConfigSchemaRefs $ toJSON _csrConfigSchema
otherSchemasValue = rewriteOpenApiRefsToConfigSchemaRefs . toJSON <$> _csrOtherSchemas
in object
[ "configSchema" .= configSchemaValue,
"otherSchemas" .= otherSchemasValue
]
instance ToSchema ConfigSchemaResponse where
declareNamedSchema _ =
pure $ NamedSchema (Just "ConfigSchemaResponse") schema
where
schema :: Schema
schema =
mempty
{ _schemaType = Just OpenApiObject,
_schemaNullable = Just False,
_schemaRequired = ["configSchema", "otherSchemas"],
_schemaProperties =
InsOrdHashMap.fromList
[ ("configSchema", openApiSchemaSchema),
("otherSchemas", Inline otherSchemasSchema)
]
}
otherSchemasSchema :: Schema
otherSchemasSchema =
mempty
{ _schemaType = Just OpenApiObject,
_schemaNullable = Just False,
_schemaAdditionalProperties = Just $ AdditionalPropertiesSchema openApiSchemaSchema
}
openApiSchemaSchema :: Referenced Schema
openApiSchemaSchema =
Ref (Reference "https://raw.githubusercontent.com/OAI/OpenAPI-Specification/80c781e479f85ac67001ceb3e7e410e25d2a561b/schemas/v3.0/schema.json#/definitions/Schema")
-- | Rewrites the config schema internal refs to the form that openapi3 expects when it deserialized them
--
-- This works around a limitation of the openapi3 library where it expects that all refs will be pointing
-- to the place in the overall document where those particular things are normally stored on specifically
-- the 'OpenApi' type and nothing else.
-- This means that it cannot understand refs like #/otherSchemas/Thing, and must see #/components/schemas/Thing
-- to correctly deserialise
rewriteConfigSchemaRefsToOpenApiRefs :: Value -> Value
rewriteConfigSchemaRefsToOpenApiRefs = rewriteSchemaRefs configSchemaToOpenApiSchemaRef
configSchemaToOpenApiSchemaRef :: Text -> Text
configSchemaToOpenApiSchemaRef = \case
(Text.stripPrefix "#/otherSchemas/" -> Just suffix) -> "#/components/schemas/" <> suffix
other -> other
-- | Rewrites the refs that openapi3 serializes to their proper pathing given their actual location
-- in the 'ConfigSchemaResponse' type.
--
-- This works around a limitation of the openapi3 library where it expects that all refs will be pointing
-- to the place in the overall document where those particular things are normally stored on specifically
-- the 'OpenApi' type and nothing else.
rewriteOpenApiRefsToConfigSchemaRefs :: Value -> Value
rewriteOpenApiRefsToConfigSchemaRefs = rewriteSchemaRefs openApiSchemaToConfigSchemaRef
openApiSchemaToConfigSchemaRef :: Text -> Text
openApiSchemaToConfigSchemaRef = \case
(Text.stripPrefix "#/components/schemas/" -> Just suffix) -> "#/otherSchemas/" <> suffix
other -> other
rewriteSchemaRefs :: (Text -> Text) -> Value -> Value
rewriteSchemaRefs rewriteRefText schemaObj =
schemaObj
& key "allOf" . values %~ rewriteRef
& key "oneOf" . values %~ rewriteRef
& key "not" %~ rewriteRef
& key "anyOf" . values %~ rewriteRef
& key "properties" . members %~ rewriteRef
& key "additionalProperties" %~ rewriteRef
& key "items" %~ rewriteRef -- if its an Object
& key "items" . values %~ rewriteRef -- if its an Array
where
rewriteRef :: Value -> Value
rewriteRef refOrInlineSchema =
-- If its $ref rewrite it, otherwise it's an inline schema, so recurse
fromMaybe (rewriteSchemaRefs rewriteRefText refOrInlineSchema) $ tryRewriteRef refOrInlineSchema
tryRewriteRef :: Value -> Maybe Value
tryRewriteRef refOrInlineSchema = do
refText <- refOrInlineSchema ^? key "$ref" . _String
pure $ refOrInlineSchema & key "$ref" . _String .~ rewriteRefText refText
validateConfigAgainstConfigSchema :: ConfigSchemaResponse -> Config -> [ValidationError]
validateConfigAgainstConfigSchema ConfigSchemaResponse {..} (Config config) =
OpenApi.validateJSON _csrOtherSchemas _csrConfigSchema (Object config)
-- | Fixes any refs in schemas that are external refs to an http-based URL.
-- Note that this is limited to schemas in the components/schemas section.
-- This is used to specifically address the external refs defined by the
-- OpenAPI schema spec of the 'ConfigSchemaResponse' type.
--
-- This works around a limitation in the openapi3 library where it does not
-- understand the concept of external refs and will always assume any defined
-- ref refers to a schema inside the top level OpenApi document itself.
-- Practically, this means that #/components/schemas/ gets mashed onto the
-- front of any external ref :(
fixExternalSchemaRefsInComponentSchemas :: Value -> Value
fixExternalSchemaRefsInComponentSchemas openApiObj =
openApiObj
& key "components" . key "schemas" . members %~ fixExternalSchemaRefsInSchema
fixExternalSchemaRefsInSchema :: Value -> Value
fixExternalSchemaRefsInSchema = rewriteSchemaRefs fixExternalHttpSchemaRef
fixExternalHttpSchemaRef :: Text -> Text
fixExternalHttpSchemaRef = \case
(Text.stripPrefix "#/components/schemas/http" -> Just suffix) -> "http" <> suffix
other -> other

View File

@ -7,9 +7,9 @@ import Data.Environment (Environment)
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text.Extended (toTxt)
import Data.Text qualified as Text
import Data.Text.Extended (toTxt, (<<>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Types (ConnSourceConfig (..))
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
import Hasura.Backends.DataConnector.Agent.Client qualified as Agent.Client
import Hasura.Backends.DataConnector.IR.Expression qualified as IR.E
@ -31,9 +31,10 @@ import Hasura.SQL.Backend (BackendSourceKind (..), BackendType (..))
import Hasura.SQL.Types (CollectableType (..))
import Hasura.Server.Utils qualified as HSU
import Hasura.Session (SessionVariable, mkSessionVariable)
import Hasura.Tracing (noReporter, runTraceTWithReporter)
import Hasura.Tracing (TraceT, noReporter, runTraceTWithReporter)
import Language.GraphQL.Draft.Syntax qualified as GQL
import Network.HTTP.Client qualified as HTTP
import Servant.Client (AsClientT)
import Witch qualified
instance BackendMetadata 'DataConnector where
@ -55,13 +56,15 @@ resolveSourceConfig' ::
DC.DataConnectorBackendConfig ->
Environment ->
m (Either QErr DC.SourceConfig)
resolveSourceConfig' _sourceName (ConnSourceConfig config) (DataConnectorKind dataConnectorName) backendConfig _ = runExceptT do
resolveSourceConfig' sourceName (DC.ConnSourceConfig config) (DataConnectorKind dataConnectorName) backendConfig _ = runExceptT do
DC.DataConnectorOptions {..} <-
OMap.lookup dataConnectorName backendConfig
`onNothing` throw400 DataConnectorError ("Data connector named " <> toTxt dataConnectorName <> " was not found in the data connector backend config")
manager <- liftIO $ HTTP.newManager HTTP.defaultManagerSettings
API.Routes {..} <- liftIO $ Agent.Client.client manager _dcoUri
schemaResponse <- runTraceTWithReporter noReporter "resolve source" $ _schema config
routes@API.Routes {..} <- liftIO $ Agent.Client.client manager _dcoUri
schemaResponse <- runTraceTWithReporter noReporter "resolve source" $ do
validateConfiguration routes sourceName dataConnectorName config
_schema config
pure
DC.SourceConfig
{ _scEndpoint = _dcoUri,
@ -70,6 +73,24 @@ resolveSourceConfig' _sourceName (ConnSourceConfig config) (DataConnectorKind da
_scManager = manager
}
validateConfiguration ::
MonadIO m =>
API.Routes (AsClientT (TraceT (ExceptT QErr m))) ->
SourceName ->
DC.DataConnectorName ->
API.Config ->
TraceT (ExceptT QErr m) ()
validateConfiguration API.Routes {..} sourceName dataConnectorName config = do
configSchemaResponse <- _configSchema
let errors = API.validateConfigAgainstConfigSchema configSchemaResponse config
if errors /= []
then
let errorsText = Text.unlines (("- " <>) . Text.pack <$> errors)
in throw400
DataConnectorError
("Configuration for source " <> sourceName <<> " is not valid based on the configuration schema declared by the " <> dataConnectorName <<> " data connector agent. Errors:\n" <> errorsText)
else pure ()
resolveDatabaseMetadata' ::
Applicative m =>
SourceMetadata 'DataConnector ->

View File

@ -40,7 +40,7 @@ import Data.Text.Extended
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as TL
import GHC.Stats.Extended qualified as RTS
import Hasura.Backends.DataConnector.API (openApiSchema)
import Hasura.Backends.DataConnector.API (openApiSchemaJson)
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Base.Error
import Hasura.EncJSON
@ -1069,7 +1069,7 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir enableTelemet
spockAction encodeQErr id $
mkGetHandler $ do
onlyAdmin
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue openApiSchema) [])
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue openApiSchemaJson) [])
Spock.get "api/swagger/json" $
spockAction encodeQErr id $
mkGetHandler $ do

View File

@ -0,0 +1,91 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
module Hasura.Backends.DataConnector.API.V0.ConfigSchemaSpec (spec) where
import Data.Aeson (toJSON)
import Data.Aeson.QQ.Simple (aesonQQ)
import Data.Data (Proxy (..))
import Data.OpenApi (OpenApiItems (..), OpenApiType (..), Reference (..), Referenced (..), Schema (..), toSchema)
import Hasura.Backends.DataConnector.API.V0.API
import Hasura.Prelude
import Test.Aeson.Utils (testToFromJSON)
import Test.Hspec
spec :: Spec
spec = do
describe "ConfigSchemaResponse" $ do
let tableNameSchema =
mempty
{ _schemaType = Just OpenApiString,
_schemaNullable = Just False
}
tablesSchema =
mempty
{ _schemaDescription = Just "List of tables to make available in the schema and for querying",
_schemaType = Just OpenApiArray,
_schemaNullable = Just True,
_schemaItems = Just $ OpenApiItemsObject (Ref $ Reference "TableName")
}
_csrConfigSchema =
mempty
{ _schemaType = Just OpenApiObject,
_schemaNullable = Just False,
_schemaProperties =
[("tables", Ref $ Reference "Tables")]
}
_csrOtherSchemas =
[ ("Tables", tablesSchema),
("TableName", tableNameSchema)
]
val = ConfigSchemaResponse {..}
jsonVal =
[aesonQQ|
{
"configSchema": {
"type": "object",
"nullable": false,
"properties": {
"tables": { "$ref": "#/otherSchemas/Tables" }
}
},
"otherSchemas": {
"Tables": {
"description": "List of tables to make available in the schema and for querying",
"type": "array",
"items": { "$ref": "#/otherSchemas/TableName" },
"nullable": true
},
"TableName": {
"nullable": false,
"type": "string"
}
}
}
|]
testToFromJSON val jsonVal
it "produces the correct OpenAPI Spec once external schema refs are fixed up" $
fixExternalSchemaRefsInSchema (toJSON $ toSchema (Proxy @ConfigSchemaResponse))
`shouldBe` [aesonQQ|
{
"required": [
"configSchema",
"otherSchemas"
],
"type": "object",
"nullable": false,
"properties": {
"configSchema": {
"$ref": "https://raw.githubusercontent.com/OAI/OpenAPI-Specification/80c781e479f85ac67001ceb3e7e410e25d2a561b/schemas/v3.0/schema.json#/definitions/Schema"
},
"otherSchemas": {
"additionalProperties": {
"$ref": "https://raw.githubusercontent.com/OAI/OpenAPI-Specification/80c781e479f85ac67001ceb3e7e410e25d2a561b/schemas/v3.0/schema.json#/definitions/Schema"
},
"type": "object",
"nullable": false
}
}
}
|]

View File

@ -1,6 +1,7 @@
module Hasura.Backends.DataConnector.API.V0Spec (spec) where
import Hasura.Backends.DataConnector.API.V0.ColumnSpec qualified as ColumnSpec
import Hasura.Backends.DataConnector.API.V0.ConfigSchemaSpec qualified as ConfigSchemaSpec
import Hasura.Backends.DataConnector.API.V0.ExpressionSpec qualified as ExpressionSpec
import Hasura.Backends.DataConnector.API.V0.OrderBySpec qualified as OrderBySpec
import Hasura.Backends.DataConnector.API.V0.QuerySpec qualified as QuerySpec
@ -13,6 +14,7 @@ import Test.Hspec
spec :: Spec
spec = do
describe "Column" ColumnSpec.spec
describe "ConfigSchema" ConfigSchemaSpec.spec
describe "Expression" ExpressionSpec.spec
describe "OrderBy" OrderBySpec.spec
describe "Query" QuerySpec.spec

View File

@ -6,11 +6,12 @@ import Control.Monad ((>=>))
import Data.Aeson.Text (encodeToLazyText)
import Data.Proxy (Proxy (..))
import Data.Text.Lazy.IO qualified as Text
import Hasura.Backends.DataConnector.API (Routes (..), apiClient, openApiSchema)
import Hasura.Backends.DataConnector.API (Routes (..), apiClient, openApiSchemaJson)
import Hasura.Backends.DataConnector.API qualified as API
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Servant.API (NamedRoutes)
import Servant.Client (Client, ClientError, hoistClient, mkClientEnv, runClientM, (//))
import Test.ConfigSchemaSpec qualified
import Test.Hspec (Spec)
import Test.Hspec.Core.Runner (runSpec)
import Test.Hspec.Core.Util (filterPredicate)
@ -21,6 +22,7 @@ import Prelude
tests :: Client IO (NamedRoutes Routes) -> API.Config -> API.Capabilities -> Spec
tests api agentConfig capabilities = do
Test.ConfigSchemaSpec.spec api agentConfig
Test.SchemaSpec.spec api agentConfig capabilities
Test.QuerySpec.spec api agentConfig capabilities
@ -33,7 +35,7 @@ main = do
agentCapabilities <- getAgentCapabilities api _toAgentConfig _toAgentCapabilities
runSpec (tests api _toAgentConfig agentCapabilities) (applyTestConfig defaultConfig testOptions) >>= evaluateSummary
ExportOpenAPISpec ->
Text.putStrLn $ encodeToLazyText openApiSchema
Text.putStrLn $ encodeToLazyText openApiSchemaJson
pure ()

View File

@ -0,0 +1,14 @@
module Test.ConfigSchemaSpec (spec) where
import Hasura.Backends.DataConnector.API (Config, Routes (..), validateConfigAgainstConfigSchema)
import Servant.API (NamedRoutes)
import Servant.Client (Client, (//))
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Expectations.Pretty (shouldBe)
import Prelude
spec :: Client IO (NamedRoutes Routes) -> Config -> Spec
spec api config = describe "config schema API" $ do
it "returns a schema that can be used to validate the current config" $ do
configSchema <- api // _configSchema
validateConfigAgainstConfigSchema configSchema config `shouldBe` []