diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 7167fc500f8..b7edf095698 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -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 diff --git a/server/src-dc-api/Hasura/Backends/DataConnector/API.hs b/server/src-dc-api/Hasura/Backends/DataConnector/API.hs index ff23d629994..d01c7d38bdf 100644 --- a/server/src-dc-api/Hasura/Backends/DataConnector/API.hs +++ b/server/src-dc-api/Hasura/Backends/DataConnector/API.hs @@ -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)) diff --git a/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/API.hs b/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/API.hs index 35b91725c5b..8833ee2ab04 100644 --- a/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/API.hs +++ b/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/API.hs @@ -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 diff --git a/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/ConfigSchema.hs b/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/ConfigSchema.hs new file mode 100644 index 00000000000..249954b817f --- /dev/null +++ b/server/src-dc-api/Hasura/Backends/DataConnector/API/V0/ConfigSchema.hs @@ -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 diff --git a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs index e2fd393b022..841eb154f6e 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs @@ -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 -> diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 12767e33dc1..6208f7b9116 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -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 diff --git a/server/src-test/Hasura/Backends/DataConnector/API/V0/ConfigSchemaSpec.hs b/server/src-test/Hasura/Backends/DataConnector/API/V0/ConfigSchemaSpec.hs new file mode 100644 index 00000000000..b4ee61f15f1 --- /dev/null +++ b/server/src-test/Hasura/Backends/DataConnector/API/V0/ConfigSchemaSpec.hs @@ -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 + } + } + } + |] diff --git a/server/src-test/Hasura/Backends/DataConnector/API/V0Spec.hs b/server/src-test/Hasura/Backends/DataConnector/API/V0Spec.hs index a66c502db10..e96c9d06c45 100644 --- a/server/src-test/Hasura/Backends/DataConnector/API/V0Spec.hs +++ b/server/src-test/Hasura/Backends/DataConnector/API/V0Spec.hs @@ -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 diff --git a/server/tests-dc-api/Main.hs b/server/tests-dc-api/Main.hs index 082c78fd109..fee87273bc6 100644 --- a/server/tests-dc-api/Main.hs +++ b/server/tests-dc-api/Main.hs @@ -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 () diff --git a/server/tests-dc-api/Test/ConfigSchemaSpec.hs b/server/tests-dc-api/Test/ConfigSchemaSpec.hs new file mode 100644 index 00000000000..191507ea65b --- /dev/null +++ b/server/tests-dc-api/Test/ConfigSchemaSpec.hs @@ -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` []